home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / program / misc / fpl-v13.lha / fpl / src / numexpr.c < prev    next >
C/C++ Source or Header  |  1995-09-25  |  91KB  |  2,765 lines
  1. /******************************************************************************
  2.  *                        FREXX PROGRAMMING LANGUAGE                          *
  3.  ******************************************************************************
  4.  
  5.  numexpr.c
  6.  
  7.  Supports *FULL* C language expression operator priority and much more...!
  8.  
  9.  *****************************************************************************/
  10.  
  11. /************************************************************************
  12.  *                                                                      *
  13.  * fpl.library - A shared library interpreting script langauge.         *
  14.  * Copyright (C) 1992-1994 FrexxWare                                    *
  15.  * Author: Daniel Stenberg                                              *
  16.  *                                                                      *
  17.  * This program is free software; you may redistribute for non          *
  18.  * commercial purposes only. Commercial programs must have a written    *
  19.  * permission from the author to use FPL. FPL is *NOT* public domain!   *
  20.  * Any provided source code is only for reference and for assurance     *
  21.  * that users should be able to compile FPL on any operating system     *
  22.  * he/she wants to use it in!                                           *
  23.  *                                                                      *
  24.  * You may not change, resource, patch files or in any way reverse      *
  25.  * engineer anything in the FPL package.                                *
  26.  *                                                                      *
  27.  * This program is distributed in the hope that it will be useful,      *
  28.  * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
  29.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                 *
  30.  *                                                                      *
  31.  * Daniel Stenberg                                                      *
  32.  * Ankdammsgatan 36, 4tr                                                *
  33.  * S-171 43 Solna                                                       *
  34.  * Sweden                                                               *
  35.  *                                                                      *
  36.  * FidoNet 2:201/328    email:dast@sth.frontec.se                       *
  37.  *                                                                      *
  38.  ************************************************************************/
  39.  
  40. #ifdef AMIGA
  41. #include <exec/types.h>
  42. #include <proto/exec.h>
  43. #elif defined(UNIX)
  44. #include <sys/types.h>
  45. #endif
  46.  
  47. #include "script.h"
  48. #include <stdio.h>
  49. #include <stddef.h>
  50. #include <limits.h>
  51.  
  52. #include "debug.h"
  53.  
  54. static ReturnCode AddUnary(struct Data *, struct Expr *, Operator);
  55. static ReturnCode Calc(struct Data *, struct Expr *, struct Expr *);
  56. static ReturnCode INLINE GetArrayInfo(struct Data *, long *, long *, long, uchar *);
  57. static ReturnCode INLINE Convert(struct Expr *, struct Data *);
  58. static void Clean(struct Data *, struct Expr *);
  59. static ReturnCode INLINE CallFunction(struct Data *, struct fplArgument *,
  60.                                       struct Identifier *);
  61. static ReturnCode INLINE PrototypeInside(struct Data *,
  62.                      struct Expr *val,
  63.                      long,
  64.                      struct Identifier *);
  65. static ReturnCode INLINE inside(struct Data *, struct fplArgument *,
  66.                                 struct Identifier *);
  67.  
  68. #ifdef STRING_STACK
  69. static ReturnCode INLINE StringToStack(struct Data *,
  70.                                        struct fplStr **);
  71. static ReturnCode INLINE StringFromStack(struct Data *,
  72.                                          struct fplStr **);
  73. #endif
  74.  
  75. /***********************************************************************
  76.  *
  77.  * int Expression(struct Expr *, struct Data *, uchar, struct Local *)
  78.  *
  79.  * Returns a nonzero value if any error occured.
  80.  * The result of the Expression is returned in the Expr structure which you
  81.  * give the pointer to in the first argument.
  82.  *
  83.  *****************/
  84.  
  85. ReturnCode REGARGS
  86. Expression(struct Expr *val, /* return value struct pointer */
  87.            struct Data *scr, /* everything */
  88.            long control,    /* ESPECIALLLY DEFINED */
  89.            struct Identifier *ident) /* pointer to the pointer holding
  90.                                         the local variable names linked
  91.                                         list */
  92. {
  93.   struct Expr *expr, *basexpr;
  94.   ReturnCode ret;
  95.   struct Identifier *pident; /* general purpose struct identifier pointer */
  96.   struct Unary *un; /* general purpose struct Unary pointers */
  97.   long *dims=NULL; /* dimension pointer for variable arrays! */
  98.   long pos;       /* general purpose integer */
  99.   uchar *text;     /* general purpose char pointer */
  100.   uchar hit;
  101.   uchar *array;
  102.   long num;
  103.   long *nump;     /* for general purpose long pointers */
  104.   struct fplMsg *msg;
  105.   struct fplStr *string;
  106. #if defined(AMIGA) && defined(SHARED)
  107.   if(ret=CheckStack(scr, scr->stack_limit, scr->stack_margin)) {
  108.     if(ret==1)
  109.       return(FPLERR_OUT_OF_MEMORY);
  110.     else
  111.       return(FPLERR_OUT_OF_STACK);
  112.   }
  113. #endif
  114.  
  115.   GETMEM(expr, sizeof(struct Expr));
  116.   memset(expr, 0, sizeof(struct Expr));
  117.   basexpr=expr;
  118.  
  119.   do {
  120.     if(ret=Eat(scr)) {       /* getaway blanks and comments */
  121.       if(control&CON_END && ret==FPLERR_UNEXPECTED_END) {
  122.         /* If there can be an unexpected ending, break out of the loop
  123.            with a nice return code! */
  124.         break;
  125.       }
  126.     } else if(expr->flags&FPL_STRING && !(control&CON_GROUNDLVL))
  127.       /* get outta string calcs if not on ground level! */
  128.       break;
  129.  
  130.     if(!(expr->flags&FPL_OPERAND)) {  /* operand coming up */
  131.  
  132.       if(control&CON_IDENT || isident(*scr->text)) {
  133.         /*
  134.          * It's a valid identifier character.
  135.          */
  136.         uchar *point;
  137.         num=0; /* Dimension counter when taking care of array variables */
  138.  
  139.         if(control&CON_IDENT) {
  140.           if(!ident)
  141.             ret=FPLERR_IDENTIFIER_NOT_FOUND;
  142.           control&=~CON_IDENT; /* switch off that bit to get away from any
  143.                                   trouble such as double using this! */
  144.         } else {
  145.           CALL(Getword(scr));
  146.           ret=GetIdentifier(scr, scr->buf, &ident);
  147.         }
  148.  
  149.         point=scr->text;
  150.         Eat(scr); /* getaway blanks */
  151.  
  152.         /*
  153.          * `ret' can only be FPL_OK or FPLERR_IDENTIFIER_NOT_FOUND at this
  154.          * position.
  155.          */
  156.  
  157.         if(control&CON_DECLARE && *scr->text==CHAR_OPEN_PAREN) {
  158.       CALL(PrototypeInside(scr, val, control, ident));
  159.       expr->flags|=FPL_OPERAND|FPL_ACTION;
  160.  
  161.         } else if(control&CON_DECLARE ||
  162.                   (ident && ident->flags&FPL_VARIABLE)) {
  163.           /* The ident check above really must be there, otherwise we might
  164.              read it when it is a NULL pointer" */
  165.  
  166.           /* it's a variable */
  167.           pident=ident;
  168.           if(ret &&                     /* we didn't find it... */
  169.              !(control&CON_DECLARE))    /* and we're not declaring! */
  170.             /*
  171.              * We didn't find the requested identifier and we're *NOT*
  172.              * declaring. This means error!
  173.              */
  174.             return(ret);
  175.           else if(!ret) {
  176.         if(ident->flags&FPL_REFERENCE)
  177.           return FPLERR_ILLEGAL_VARIABLE; /* this is a reference _only_! */
  178.  
  179.             /* The symbol was found */
  180.         if(control&CON_LEVELOK) /* level _is_ OK! */
  181.           ;
  182.             else if(control&CON_DECLARE &&
  183.            (ident->level>=scr->varlevel || scr->varlevel==1)) {
  184.               /*
  185.                * If the name already declared in this (or higher) level
  186.                * and declaration is wanted.
  187.                */
  188.               if((ident->flags&FPL_STATIC_VARIABLE &&
  189.                   control&CON_DECLSTATIC &&
  190.                   ident->level==scr->varlevel) ||
  191.                  /*
  192.                   * If this is a `static' variable and the variable already
  193.                   * exists on this very level in this very function as static,
  194.                   * then skip this. It's perfectly OK to jump to the ending
  195.                   * semicolon since this has been parsed before!
  196.                   */
  197.  
  198.                  (ident->flags&FPL_EXPORT_SYMBOL && control&CON_DECLEXP)) {
  199.  
  200.                 /*
  201.                  * If this is an `export' symbol and it already exists as an
  202.                  * `export' symbol! Then just ignore this!
  203.                  */
  204.  
  205.                 /*
  206.                  * The current implementation unfortunately uses the statement
  207.                  * below to pass this declaration. That means comma-
  208.                  * separated exported symbols will be passed if only the first
  209.                  * is alredy declared... This will although work in all those
  210.                  * cases it is the SAME code that is executed twice!
  211.                  */
  212.  
  213.  
  214.                 if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
  215.                   return FPLERR_MISSING_SEMICOLON;
  216.                 scr->text--; /* get back on the semicolon! */
  217.                 break;
  218.               } else {
  219.                 CALL(Warn(scr, FPLERR_IDENTIFIER_USED));
  220.                 /* run it over! */
  221.                 DelIdentifier(scr, ident->name, NULL);
  222.               }
  223.             } else if(!(control&CON_DECLARE) &&
  224.                       (ident->level && /* not global */
  225.                        ident->level<(scr->varlevel-scr->level)))
  226.               /*
  227.                * From the wrong program level and we're not declaring.
  228.                */
  229.               return(FPLERR_IDENTIFIER_NOT_FOUND);
  230.             else if(ident->flags&FPL_STATIC_VARIABLE &&
  231.                     ((ident->func && (ident->func==scr->func)) ||
  232.                      ident->level>scr->varlevel)
  233.                     )
  234.               /*
  235.                * A static variable declared either in the wrong function or
  236.                * in a higher level!
  237.                */
  238.               return(FPLERR_IDENTIFIER_NOT_FOUND);
  239.           }
  240.  
  241.           text = NULL; /* no name information yet! */
  242.  
  243.       control &= ~CON_LEVELOK; /* forget about the level OK stuff!! */
  244.  
  245.           if(*scr->text==CHAR_OPEN_BRACKET) {
  246.             /*
  247.              * It's an array. Get the result of the expression within the
  248.              * square brackets.
  249.              */
  250.  
  251.             if(!dims) {
  252.               GETMEM(dims, MAX_DIMS*sizeof(long));
  253.             }
  254.             if(!(control&CON_DECLARE) && pident->data.variable.size)
  255.               num=pident->data.variable.num;
  256.             if(control&CON_DECLARE || num) {
  257.               /*
  258.                * Get the name now, cause the GetArrayInfo() call may
  259.                * destroy the 'scr->buf' buffer!
  260.                */
  261.               STRDUP(text, scr->buf);
  262.  
  263.               GETMEM(nump, sizeof(long));
  264.               *nump = num;
  265.               CALL(GetArrayInfo(scr, dims, nump, control, text));
  266.               num = *nump;
  267.               FREE(nump);
  268.               if(!(control&CON_DECLARE)) {
  269.                 /*
  270.                  * Free the name now, cause we don't declare anything
  271.                  * and this isn't needed any more!
  272.                  */
  273.                 FREE(text);
  274.                 text = NULL;
  275.               }
  276.               if(!(control&CON_DECLARE)) {
  277.                 if(num > pident->data.variable.num) {
  278.                   /*
  279.                    * If not declaring and overfilled quota: fail!
  280.                    *
  281.                    *
  282.                    * Copy the variable name to the buffer to make the
  283.                    * error message look good!
  284.                    */
  285.                   strcpy(scr->buf, pident->name);
  286.                   return FPLERR_ILLEGAL_ARRAY;
  287.                   
  288.                 } else {
  289.                   for(pos=0; pos<num; pos++)
  290.                     if(pident->data.variable.dims[pos]<=dims[pos]) {
  291.                       /*
  292.                        * Copy the variable name to the buffer to make the
  293.                        * error message look good!
  294.                        */
  295.                       strcpy(scr->buf, pident->name);
  296.                       return FPLERR_ILLEGAL_ARRAY;
  297.                     }
  298.                 }
  299.               }
  300.               point=scr->text; /* move point to current location  */
  301.               Eat(scr); /* pass all traling whitespaces */
  302.             }
  303.           }
  304.           if(control&CON_DECLARE) {
  305.             expr->flags|=FPL_ACTION;
  306.             GETMEM(pident, sizeof(struct Identifier));
  307.  
  308.             pident->level=
  309.               (control&(CON_DECLEXP|CON_DECLGLOB))?0:scr->varlevel;
  310.             pident->flags=
  311.               (control&CON_DECLINT?FPL_INT_VARIABLE:FPL_STRING_VARIABLE)|
  312.                 (control&CON_DECLEXP?FPL_EXPORT_SYMBOL:0)|
  313.  
  314.                   (control&CON_DECLGLOB?FPL_GLOBAL_SYMBOL:
  315.                     (control&CON_DECLSTATIC?FPL_STATIC_VARIABLE:0))|
  316.  
  317.                     (control&CON_DECL8?FPL_CHAR_VARIABLE:
  318.                      (control&CON_DECL16?FPL_SHORT_VARIABLE:0))|
  319.  
  320.                        (control&CON_DECLCONST?FPL_READONLY:0);
  321.  
  322.             pident->file=scr->prog->name; /* file */
  323.  
  324.             pident->func=scr->func; /* declared in this function */
  325.  
  326.             /* Get variable name */
  327.             if(text)
  328.               /*
  329.                * The name has already been allocated above!
  330.                */
  331.               pident->name = text;
  332.             else {
  333.               /*
  334.                * Get the name!
  335.                */
  336.               STRDUP(pident->name, scr->buf); /* no real strdup */
  337.             }
  338.             if(num) {
  339.               /*
  340.                * Array variable declaration! It is a bit different from
  341.                * common variable declaration so I decided to put the code
  342.                * for it right here:
  343.                */
  344.               long size=dims[0]; /* array size */
  345.  
  346.               for(pos=1; pos<num; pos++)
  347.                 size*=dims[pos];
  348.  
  349.               /* Now `size' is the total number of members in the array we're
  350.                  about to declare */
  351.  
  352.               /* Get memory for the dimension array */
  353.               GETMEM(pident->data.variable.dims, num * sizeof(long));
  354.  
  355.               /* Copy the dim info to the newly allocated area */
  356.               memcpy((void *)pident->data.variable.dims, dims, num*sizeof(long));
  357.  
  358.               /* Get memory for the array  */
  359.               GETMEM(pident->data.variable.var.val32, size * sizeof(long));
  360.  
  361.               /* Set all string lengths to NULL and integers to zero: */
  362.               memset(pident->data.variable.var.val32, 0, size * sizeof(void *));
  363.  
  364.               pident->data.variable.size=size; /* total number of array members */
  365.               pident->data.variable.num=num;   /* number of dimensions */
  366.  
  367.               /* reset the dims array! */
  368.               memset((void *)dims, 0, sizeof(long) * num);
  369.  
  370.               /* reset num: */
  371.               num=1;
  372.  
  373.             } else {
  374. #ifdef DEBUG
  375.               CheckMem(scr, pident);
  376. #endif
  377.  
  378.               GETMEM(pident->data.variable.var.val32, sizeof(long));
  379.               *pident->data.variable.var.val32=0;
  380.               pident->data.variable.num=0;
  381.               pident->data.variable.size=1;
  382.             }
  383.             /*
  384.              * We add the symbol to the local data in all cases except when
  385.              * the symbol is global or static.
  386.              */
  387.             CALL(AddVar(scr, pident,
  388.                         control&(CON_DECLGLOB|CON_DECLSTATIC)?
  389.                         &scr->globals:&scr->locals));
  390.           }
  391.  
  392.           /*
  393.            * Now when all declarations is done, all assigns are left:
  394.            */
  395.  
  396.           expr->flags|=FPL_OPERAND;
  397.           if (pident->flags&FPL_STRING_VARIABLE) { /* string variable */
  398.             if(*scr->text==CHAR_OPEN_BRACKET) { /* just one character */
  399.               /*
  400.                * Get the result of the expression.
  401.                */
  402.               uchar *value;
  403.               if(control&CON_STRING) {
  404.                 /* NO integers allowed! */
  405.                 return FPLERR_UNEXPECTED_INT_STATEMENT;
  406.               }
  407.               CALL(Expression(val, (scr->text++, scr),
  408.                               CON_GROUNDLVL|CON_NUM, NULL));
  409.               if(val->val.val<0) {
  410.                 strcpy(scr->buf, pident->name);
  411.                 return FPLERR_STRING_INDEX; /* we don't know what was meant! */
  412.               }
  413.  
  414.               if(*scr->text!=CHAR_CLOSE_BRACKET) {
  415.                 CALL(Warn(scr, FPLERR_MISSING_BRACKET));
  416.                 /* we can continue anyway! */
  417.               } else
  418.                 scr->text++;
  419.  
  420.               CALL(Eat(scr)); /* eat white space */
  421.  
  422.               if(pident->data.variable.num) {
  423.                 /* pick out the proper array member */
  424.                 pos=ArrayNum(num, pident->data.variable.num,
  425.                              dims, pident->data.variable.dims);
  426.                 if(pos<0) {
  427.                   strcpy(scr->buf, pident->name);
  428.                   return FPLERR_ILLEGAL_ARRAY; /* we don't know what was meant! */
  429.                 }
  430.               } else
  431.                 pos=0;
  432.  
  433.               if(pident->data.variable.var.str[pos] &&
  434.                  (val->val.val >= pident->data.variable.var.str[pos]->len)) {
  435.                 /* force to zero! */
  436.                 val->val.val=0;
  437.               }
  438.               if(!pident->data.variable.var.str[pos] ||
  439.                  !pident->data.variable.var.str[pos]->len)
  440.                 /* no-length-string */
  441.                 return FPLERR_STRING_INDEX;
  442.               
  443.               /*
  444.                * (I) Here we should be able to operate the character read
  445.                * from the string. ++ and -- should work to enable advanced
  446.                * string modification handling without the
  447.                * overhead of getting the string, changing it and then re-
  448.                * assign it back. This *MUST* be implemented soon cause
  449.                * it's a real killer!
  450.                */
  451.  
  452.               value=(uchar *)&pident->data.variable.var.str[pos]->string[val->val.val];
  453.  
  454.               if(ASSIGN_OPERATOR) {
  455.                 uchar was=*scr->text;
  456.                 long valint=*value;
  457.                 if(pident->flags&FPL_READONLY)
  458.                   return FPLERR_READONLY_VIOLATE;                  
  459.                 expr->flags|=FPL_ACTION;
  460.                 if(*scr->text==CHAR_ASSIGN)
  461.                   scr->text++;
  462.                 else if(scr->text[2]==CHAR_ASSIGN)
  463.                   scr->text+=3;
  464.                 else
  465.                   scr->text+=2;
  466.                 /* single assign */
  467.                 CALL(Expression(val, scr, CON_NORMAL|CON_NUM, NULL));
  468.                 CALL(CmpAssign(scr, val->val.val, &valint, FPL_CHAR_VARIABLE, was));
  469.                 *value=valint;
  470.               }
  471.  
  472.               expr->val.val=*value; /* only one byte */
  473.               CALL(NewMember(scr, &expr));
  474.             } else if(control&CON_NUM) {
  475.               /* NO strings allowed! */
  476.               return FPLERR_UNEXPECTED_STRING_STATEMENT;
  477.               /* be able to continue here, we must pass everything that has to
  478.                  to with the strings in this expression */
  479.             } else if (*scr->text==CHAR_ASSIGN || (*scr->text==CHAR_PLUS &&
  480.                         scr->text[1]==CHAR_ASSIGN)) {
  481.               uchar array=FALSE;
  482.               uchar multi=FALSE;
  483.               struct fplStr **string; /* current string */
  484.               uchar app=(*scr->text==CHAR_PLUS);
  485.  
  486.               if(pident->flags&FPL_READONLY && !(control&CON_DECLARE))
  487.                 return FPLERR_READONLY_VIOLATE;
  488.  
  489.               scr->text+=1+app;
  490.               expr->flags|=FPL_ACTION;
  491.               if(pident->data.variable.num) { /* if array member assign */
  492.                 Eat(scr);
  493.                 if(*scr->text==CHAR_OPEN_BRACE) {
  494.                   /* array assign */
  495.                   multi=TRUE;
  496.                   scr->text++;
  497.                   CALL(Eat(scr));
  498.                 }
  499.                 array=TRUE;
  500.               }
  501.  
  502.               if(!multi) {
  503.                 /* single (array) variable assign */
  504.                 if(array) {
  505.                   pos=ArrayNum(num, pident->data.variable.num,
  506.                                dims, pident->data.variable.dims);
  507.                   if(pos<0) {
  508.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  509.                     pos=0; /* we don't know what was meant! */
  510.                   }
  511.                 } else
  512.                   pos=0;
  513.         CALL(Expression(val, scr, CON_STRING, NULL));
  514.         CALL(StringExpr(val, scr)); /* get more strings? */
  515.                 string=&pident->data.variable.var.str[pos];
  516.                 if(!app && val->flags&FPL_NOFREE) {
  517.                   /*
  518.                    * Only do this this is not an append action _and_
  519.                    * we can't free this string (== someone else is
  520.                    * taking care of this string!)
  521.                    */
  522.                   if(*string) {
  523.                     FREE_KIND(*string); /* free old string */
  524.                   }
  525.                   if(val->val.str) {
  526.                     /* duplicate string */
  527.                     STRFPLDUP((*string), val->val.str);
  528.                   }
  529.                   else
  530.                     *string=NULL;
  531.                 } else {
  532.                   CALL(StrAssign(val->val.str, scr, string, app));
  533.                 }
  534.                 if(*string && MALLOC_STATIC == TypeMem(pident) )
  535.                   SwapMem(scr, *string, MALLOC_STATIC);
  536.                 if(app && !(val->flags&FPL_NOFREE) && val->val.str)
  537.                   /* Only do this if appending! */
  538.                   FREE(val->val.str);
  539. #ifdef STRING_STACK
  540.                 if(app && val->val.str)
  541.                   /* the string couldn't be freed, but we let them know that
  542.                      we don't use it anymore! */
  543.                   val->val.str->flags=FPLSTR_UNUSED;
  544. #endif
  545.               } else {
  546.                 /* multi [compound] assign! */
  547.  
  548.                 /*
  549.                  * Count the preceding open braces to get proper level
  550.                  * to assign in.
  551.                  */
  552.                 while(*scr->text==CHAR_OPEN_BRACE) {
  553.                   num++; /* next dimension */
  554.                   scr->text++; /* pass it! */
  555.                   CALL(Eat(scr));
  556.                 }
  557.  
  558.                 do {
  559.                   while(1) {
  560.                     hit=TRUE;
  561.  
  562.                     /* parse the controlling braces and commas */
  563.                     switch(*scr->text) {
  564.                     case CHAR_CLOSE_BRACE:
  565.  
  566.                       num--; /* back one dimension */
  567.                       if(num>=0 && num<pident->data.variable.num)
  568.                         dims[num]=0;
  569.                       else {
  570.                         CALL(Warn(scr,FPLERR_ILLEGAL_ARRAY));
  571.                         num=0; /* force counter to zero! */
  572.                       }
  573.                       scr->text++;
  574.                       break;
  575.                     case CHAR_COMMA:
  576.                       /*
  577.                        * Increase the last dimension member for next loop:
  578.                        */
  579.  
  580.                       if(num>0 && num<=pident->data.variable.num)
  581.                         dims[num-1]++;
  582.                       else {
  583.                         CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  584.                         /* force counter back to top position! */
  585.                         num=pident->data.variable.num;
  586.                       } scr->text++;
  587.                       break;
  588.                     case CHAR_OPEN_BRACE:
  589.                       num++; /* next dimension */
  590.                       scr->text++;
  591.                       break;
  592.                     default:
  593.                       hit=FALSE;
  594.                       break;
  595.                     }
  596.                     if(hit && !ret) {
  597.                       CALL(Eat(scr));
  598.                     } else
  599.                       break;
  600.                   }
  601.  
  602.  
  603.                   if(!num)
  604.                     break;
  605.  
  606.                   pos=ArrayNum(num, pident->data.variable.num,
  607.                                dims, pident->data.variable.dims);
  608.                   if(pos<0) {
  609.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  610.                     pos=0; /* force back to sane number */
  611.                   }
  612.  
  613.                   /* assign! */
  614.  
  615.                   string=&pident->data.variable.var.str[pos];
  616.  
  617.           CALL(Expression(val, scr, CON_STRING, NULL));
  618.           CALL(StringExpr(val, scr)); /* get more strings? */
  619.  
  620.                   if(!app && val->flags&FPL_NOFREE) {
  621.                     /*
  622.                      * Only do this this is not an append action _and_
  623.                      * we can't free this string (== someone else is
  624.                      * taking care of this string!)
  625.                      */
  626.                     if(*string) {
  627.                       FREE_KIND(*string); /* free old string */
  628.                     }
  629.                     if(val->val.str) {
  630.                       STRFPLDUP((*string), val->val.str); /* duplicate string */
  631.                     }
  632.                     else
  633.                       *string = NULL;
  634.                   } else {
  635.                     CALL(StrAssign(val->val.str, scr, string, app));
  636.                   }
  637.                   if(*string && MALLOC_STATIC == TypeMem(pident))
  638.                     SwapMem(scr, *string, MALLOC_STATIC);
  639.  
  640.                   if(app && !(val->flags&FPL_NOFREE) && val->val.str) {
  641.                     /* only if we're appending! */
  642.                     FREE(val->val.str);
  643.                   }
  644.  
  645. #ifdef STRING_STACK
  646.                   if(app)
  647.                     /* the string couldn't be freed, but we let them know that
  648.                        we don't use it anymore! */
  649.                     val->val.str->flags=FPLSTR_UNUSED;
  650. #endif
  651.                   /* while  */
  652.                 } while(1);
  653.               }
  654.               expr->val.str=*string;
  655.               expr->flags|=FPL_STRING|FPL_NOFREE;
  656.             } else {
  657.               if(control&CON_DECLARE)
  658.                 expr->val.val=0;
  659.               else if(pident->data.variable.num) {
  660.                 pos=ArrayNum(num, pident->data.variable.num,
  661.                              dims, pident->data.variable.dims);
  662.                 if(pos<0) {
  663.                   CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  664.                   pos=0; /* force back to sane number */
  665.                 }
  666.                 expr->val.str=pident->data.variable.var.str[pos];
  667.               } else
  668.                 expr->val.str=pident->data.variable.var.str[0];
  669.               expr->flags|=FPL_STRING|FPL_NOFREE;
  670.           CALL(StringExpr(expr, scr));
  671.             }
  672.           } else {
  673.             /*
  674.              * Integer variable...
  675.              */
  676.             if(control&CON_STRING) {
  677.               /* NO integers allowed! */
  678.               return FPLERR_UNEXPECTED_INT_STATEMENT;
  679.             }
  680. #if 0
  681.             if(pident->flags&FPL_READONLY && !(control&CON_DECLARE)) {
  682.               if(!pident->data.variable.num)
  683.                 expr->val.val=pident->data.variable.var.val32[0];
  684.               else {
  685.                 pos=ArrayNum(num, pident->data.variable.num,
  686.                              dims, pident->data.variable.dims);
  687.                 if(pos<0) {
  688.                   CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  689.                   pos=0; /* force back to sane number */
  690.                 }
  691.  
  692.                 expr->val.val=pident->data.variable.var.val32[pos];
  693.               }
  694.             } else
  695. #endif
  696.               if(!expr->operator && !expr->unary &&
  697.                       ASSIGN_OPERATOR) {
  698.  
  699.               /* integer assign */
  700.  
  701.               uchar array=FALSE;    /* is it an array variable */
  702.               uchar multi=FALSE;    /* mutiple variable */
  703.               uchar was=*scr->text;
  704.  
  705.               if(pident->flags&FPL_READONLY && !(control&CON_DECLARE))
  706.                 return FPLERR_READONLY_VIOLATE;
  707.  
  708.               expr->flags|=FPL_ACTION;
  709.               if(*scr->text==CHAR_ASSIGN)
  710.                 scr->text++;
  711.               else if(scr->text[2]==CHAR_ASSIGN)
  712.                 scr->text+=3;
  713.               else
  714.                 scr->text+=2;
  715.               if(pident->data.variable.num) { /* if array member assign */
  716.                 Eat(scr);
  717.                 if(*scr->text==CHAR_OPEN_BRACE) {
  718.  
  719.                   /* array assign */
  720.                   multi=TRUE;
  721.                   scr->text++;
  722.                   CALL(Eat(scr));
  723.                 }
  724.                 array=TRUE;
  725.               }
  726.  
  727.               if(!multi) {
  728.                 if(!array)
  729.                   pos=0;
  730.                 else {
  731.                   /* single (array) variable assign */
  732.                   pos=ArrayNum(num, pident->data.variable.num,
  733.                                dims, pident->data.variable.dims);
  734.                   if(pos<0) {
  735.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  736.                     pos=0; /* force back to a decent number */
  737.                   }
  738.                 }
  739.  
  740.                 CALL(Expression(val, scr, CON_NORMAL|CON_NUM, NULL));
  741.  
  742.                 CALL(CmpAssign(scr, val->val.val,
  743.                                &pident->data.variable.var.val32[pos],
  744.                                pident->flags, was));
  745.                 expr->val.val=pident->data.variable.var.val32[pos];
  746.               } else {
  747.                 /* multi [compound] assign */
  748.  
  749.                 /*
  750.                  * Count the preceding open braces to get proper level
  751.                  * to assign in.
  752.                  */
  753.                 while(*scr->text==CHAR_OPEN_BRACE) {
  754.                   num++; /* next dimension */
  755.                   scr->text++; /* pass it! */
  756.                   CALL(Eat(scr));
  757.                 }
  758.  
  759.                 do {
  760.                   while(1) {
  761.                     uchar hit=TRUE;
  762.  
  763.                     /* parse the controlling braces and commas */
  764.                     switch(*scr->text) {
  765.                     case CHAR_CLOSE_BRACE:
  766.  
  767.                       num--; /* back one dimension */
  768.                       if(num>=0 && num<pident->data.variable.num)
  769.                         dims[num]=0;
  770.                       else {
  771.                         CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  772.                         num=0;
  773.                       }
  774.                       scr->text++;
  775.                       break;
  776.                     case CHAR_COMMA:
  777.                       /*
  778.                        * Increase the last dimension member for next loop:
  779.                        */
  780.                       if(num>0 && num<=pident->data.variable.num)
  781.                         dims[num-1]++;
  782.                       else {
  783.                         CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  784.                         num=pident->data.variable.num;
  785.                       }
  786.                       scr->text++;
  787.                       break;
  788.                     case CHAR_OPEN_BRACE:
  789.                       num++; /* next dimension */
  790.                       scr->text++;
  791.                       break;
  792.                     default:
  793.                       hit=FALSE;
  794.                       break;
  795.                     }
  796.                     if(hit && !ret) {
  797.                       CALL(Eat(scr));
  798.                     } else
  799.                       break;
  800.                   }
  801.  
  802.                   if(!num)
  803.                     break;
  804.  
  805.                   pos=ArrayNum(num, pident->data.variable.num,
  806.                                dims, pident->data.variable.dims);
  807.                   if(pos<0) {
  808.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  809.                     pos=0;
  810.                   }
  811.  
  812.                   /* assign! */
  813.                   CALL(Expression(val, scr, CON_NORMAL|CON_NUM, NULL));
  814.                   CALL(CmpAssign(scr, val->val.val, &pident->data.variable.var.val32[pos],
  815.                                  pident->flags, was));
  816.                   expr->val.val=pident->data.variable.var.val32[pos];
  817.  
  818.                   /* while  */
  819.                 } while(1);
  820.               }
  821.               expr->flags|=FPL_NOFREE; /* the memory pointed to by the expr->val.val
  822.                                           is strings of proper variables. Do
  823.                                           not free them now! */
  824.             } else {
  825.               /*
  826.                * No assignment, primary operator or none at all!
  827.                */
  828.               long *value;
  829.               if(control&CON_DECLARE)
  830.                 expr->val.val=0;
  831.               else {
  832.                 if(pident->data.variable.num) {
  833.                   pos=ArrayNum(num, pident->data.variable.num,
  834.                                dims, pident->data.variable.dims);
  835.                   if(pos<0) {
  836.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  837.                     pos=0;
  838.                   }
  839.                 } else
  840.                   pos=0;
  841.                 value=&pident->data.variable.var.val32[pos];
  842.  
  843.                 if(*point==CHAR_PLUS && point[1]==CHAR_PLUS) {
  844.                   /*post increment*/
  845.                   if(pident->flags&FPL_READONLY)
  846.                     return FPLERR_READONLY_VIOLATE;                  
  847.                   expr->flags|=FPL_ACTION;
  848.                   expr->val.val=(*value)++;
  849.                   scr->text+=2;
  850.                 } else if(*point==CHAR_MINUS && point[1]==CHAR_MINUS) {
  851.                   /* post decrement */
  852.                   if(pident->flags&FPL_READONLY)
  853.                     return FPLERR_READONLY_VIOLATE;                  
  854.  
  855.                   expr->flags|=FPL_ACTION;
  856.                   expr->val.val=(*value)--;
  857.                   scr->text+=2;
  858.                 } else {
  859.                   /* plain variable or pre operation */
  860.                   if(un=expr->unary) {
  861.                     if(un->unary!=OP_PREINC && un->unary!=OP_PREDEC) {
  862.                       expr->val.val=*value;
  863.                     } else {
  864.                       if(pident->flags&FPL_READONLY)
  865.                         return FPLERR_READONLY_VIOLATE;
  866.                       if(un->unary==OP_PREINC)
  867.                         expr->val.val=++(*value);
  868.                       else
  869.                         expr->val.val=--(*value);
  870.                       expr->unary=un->next;
  871.                       FREE(un);
  872.                     }
  873.                   } else
  874.                     expr->val.val=*value;
  875.                 }
  876.                 if(pident->flags&FPL_VARIABLE_LESS32) {
  877.                   if(pident->flags&FPL_CHAR_VARIABLE) {
  878.                     expr->val.val=(long)((signed char)expr->val.val);
  879.                     *value=(long)((signed char)*value);
  880.                   } else {
  881.                     /* sixteen bits */
  882.                     expr->val.val=(long)((signed short)expr->val.val);
  883.                     *value=(long)((signed short)*value);
  884.                   }
  885.                 }
  886.               }
  887.               CALL(NewMember(scr, &expr));
  888.             }
  889.           }   /* end of integer handling */
  890.         } else if(ret && (*scr->text!=CHAR_OPEN_PAREN))
  891.           return(ret); /* FPLERR_IDENTIFIER_NOT_FOUND */
  892.         else {                     /* some sort of function */
  893.           /*
  894.            * FUNCTION HANDLER PART:
  895.            */
  896.  
  897.           struct fplArgument *pass; /* struct pointer to send as argument to
  898.                                        the function handler */
  899.           long allocspace;
  900.  
  901.           if(ret) {
  902.             if(!(scr->flags&FPLDATA_ALLFUNCTIONS) ||
  903.                *scr->text!=CHAR_OPEN_PAREN)
  904.               /* If the ability to parse all functions isn't turned on, or if
  905.                  the following character is not an open parenthesis, fail! */
  906.               return(ret);
  907.           }
  908.  
  909.           num=0;    /* number of arguments */
  910.  
  911.           expr->flags|=FPL_OPERAND|FPL_ACTION; /* This sure is action...! */
  912.  
  913.           GETMEM(pass, sizeof(struct fplArgument));
  914.  
  915.           if(!ident) {
  916.             /* The function does not exist as a declared function! */
  917.             STRDUP(pass->name, scr->buf);
  918.             pass->ID=FPL_UNKNOWN_FUNCTION;
  919.             text="o>"; /* optional parameter list as argument! */
  920.           } else {
  921.             pass->name=ident->name;
  922.             pass->ID=ident->data.external.ID;
  923.             text=ident->data.inside.format;
  924.           }
  925.           pass->argc=0;
  926.           pass->key=(void *)scr;
  927.  
  928.           if(!ident || FPL_OPTEXPRARG == ident->data.inside.ret) {
  929.             /*
  930.              * The function we invoked was not found regularly!
  931.          * Set return type!
  932.          */
  933.  
  934.         /*
  935.              * We try to determine whether it should return an int or a string.
  936.              * We interpret the return value as we should do to make it pass
  937.              * as a valid expression. That is, if the flag tells us this
  938.              * should be a string expression to be valid, we take it as a
  939.              * string, but if it tells us its an integer expression, we read
  940.              * it as an integer!!!
  941.              */
  942.  
  943.             if(control&CON_STRING)
  944.               hit = FPL_STRARG;
  945.             else {
  946.               if(control&CON_NUM)
  947.                 hit = FPL_INTARG;
  948.               else
  949.                 /*
  950.                  * We don't know which kind of return code the function
  951.                  * should give us!
  952.                  */
  953.                 hit = FPL_OPTEXPRARG;
  954.             }
  955.  
  956.       } else {
  957.             hit = UPPER(ident->data.inside.ret);
  958.             if(control&CON_STRING && (hit!=FPL_STRARG))
  959.               return FPLERR_UNEXPECTED_INT_STATEMENT;
  960.             if(control&CON_NUM && (hit!=FPL_INTARG))
  961.               return FPLERR_UNEXPECTED_STRING_STATEMENT;
  962.           }
  963.  
  964.           pass->ret = hit;
  965.  
  966.           if(*scr->text!=CHAR_OPEN_PAREN) {
  967.             CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));  /* >warning< */
  968.           } else
  969.             scr->text++;
  970.  
  971.           CALL(Eat(scr));
  972.  
  973.           if(text && *text) {
  974.             uchar b='a';
  975.             uchar a;
  976.  
  977.             /* if the function takes arguments */
  978.  
  979.             /*
  980.              * Allocate arrays to use for data storage while parsing
  981.              * the arguments. Maximum number of arguments is
  982.              * MAX_ARGUMENTS.
  983.              */
  984.  
  985.             num=strlen(text);   /* number of arguments to this function */
  986.  
  987.             if(text[num-1]!=FPL_ARGLIST)
  988.               allocspace=num+1;
  989.             else
  990.               allocspace=MAX_ARGUMENTS;
  991.  
  992.             /*
  993.              * By adjusting the number of allocated bytes to the smallest
  994.              * necessary, my recursive example program used only a fifth
  995.              * as much memory as when always allocating memory for
  996.              * MAX_ARGUMENTS.
  997.              */
  998.  
  999.             /* allocate an array */
  1000.             GETMEM(pass->argv, sizeof(uchar *)*allocspace);
  1001.  
  1002.             /* allocate new format string */
  1003.             GETMEM(pass->format, sizeof(uchar)*allocspace);
  1004.  
  1005.             /* allocate allocate-flag string */
  1006.             GETMEM(array, sizeof(uchar)*allocspace);
  1007.  
  1008.             while(!ret && *scr->text!=CHAR_CLOSE_PAREN && text && *text) {
  1009.               b=(*text==FPL_ARGLIST)?b:UPPER(*text);
  1010.           if(FPL_OPTARG == b &&
  1011.          CHAR_AND == scr->text[0])
  1012.                 a = FPL_OPTVARARG;
  1013.           else
  1014.                 a = b;
  1015.  
  1016.               if(pass->argc==allocspace) {
  1017.                 uchar *temp;
  1018.                 GETMEM(temp, sizeof(uchar *)*(allocspace+MAX_ARGUMENTS));
  1019.                 memcpy(temp, pass->argv, sizeof(uchar *)*allocspace);
  1020.                 FREE(pass->argv);
  1021.                 pass->argv=(void **)temp;
  1022.  
  1023.                 GETMEM(temp, sizeof(uchar)*(allocspace+MAX_ARGUMENTS));
  1024.                 memcpy(temp, pass->format, sizeof(uchar)*allocspace);
  1025.                 FREE(pass->format);
  1026.                 pass->format=temp;
  1027.  
  1028.                 GETMEM(temp, sizeof(uchar)*(allocspace+MAX_ARGUMENTS));
  1029.                 memcpy(temp, array, sizeof(uchar)*allocspace);
  1030.                 FREE(array);
  1031.                 array=temp;
  1032.                 
  1033.                 allocspace += MAX_ARGUMENTS;
  1034.               }
  1035.  
  1036.               switch(a) {
  1037.           case FPL_OPTEXPRARG:
  1038.               case FPL_OPTARG:
  1039.               case FPL_STRARG:
  1040.                 CALL(Expression(val, scr, (a==FPL_STRARG?CON_STRING:0), NULL));
  1041.  
  1042.                 if(a==FPL_STRARG || val->flags&FPL_STRING) {
  1043.           CALL(StringExpr(val, scr)); /* get more strings? */
  1044.  
  1045.                   /* Enter string symbol in the created format string! */
  1046.                   pass->format[pass->argc]=FPL_STRARG;
  1047.  
  1048.                   if(val->val.str) {
  1049.                     /* Set this to TRUE if deallocation is wanted on this
  1050.                        string after the function call! */
  1051.                     array[pass->argc]=!(val->flags&FPL_NOFREE);
  1052.                     /*
  1053.                      * Point to the string (that is zero terminated)!
  1054.                      */
  1055.                     pass->argv[pass->argc]=val->val.str->string;
  1056.                   } else {
  1057.                     GETMEM(string, sizeof(struct fplStr));
  1058.             memset(string, 0, sizeof(struct fplStr));
  1059.             pass->argv[pass->argc]=string->string;
  1060.                     array[pass->argc]=1; /* allocation has been done! */
  1061.                   }
  1062.                 } else {
  1063.                   pass->format[pass->argc]=FPL_INTARG;
  1064.                   pass->argv[pass->argc]=(void *)val->val.val;
  1065.                 }
  1066.                 pass->argc++;
  1067.                 break;
  1068.               case FPL_INTARG:
  1069.                 CALL(Expression(val, scr, CON_NUM, NULL));
  1070.                 pass->format[pass->argc]=FPL_INTARG;
  1071.                 pass->argv[pass->argc++]=(void *)val->val.val;
  1072.                 break;
  1073.           case FPL_OPTVARARG:
  1074.               case FPL_STRVARARG:
  1075.               case FPL_INTVARARG:
  1076.           case FPL_INTARRAYVARARG:
  1077.           case FPL_STRARRAYVARARG:
  1078.                 {
  1079.                   register ReturnCode ok;
  1080.                   if(*scr->text != CHAR_AND) {
  1081.                       ok = FPLERR_ILLEGAL_REFERENCE;
  1082.                   }
  1083.                   else {
  1084.                       scr->text++;
  1085.                       ok = FPL_OK;
  1086.                   }
  1087.                   CALL(Getword(scr));
  1088.                   /* Use the `pident' pointer here, cause the `ident' pointer
  1089.                      is already being used by the function we're about to
  1090.                      invoke! */
  1091.                   CALL(GetIdentifier(scr, scr->buf, &pident));
  1092.  
  1093.                   if(ok) {
  1094.                       /* missing &-character! */
  1095.                       if(pident->flags&FPL_REFERENCE)
  1096.                         /* get the referenced variable instead! */
  1097.                         pident = pident->data.variable.ref;
  1098.                       else
  1099.                       return FPLERR_ILLEGAL_REFERENCE; /* no reference! */
  1100.                   }
  1101.                 }
  1102.  
  1103.         if(FPL_INTARRAYVARARG == a || FPL_STRARRAYVARARG == a) {
  1104.             if(!pident->data.variable.num)
  1105.             return FPLERR_ILLEGAL_REFERENCE;
  1106.         }
  1107.         else if(FPL_OPTVARARG != a && pident->data.variable.num)
  1108.             /* only straight variables! */
  1109.             return FPLERR_ILLEGAL_PARAMETER;
  1110.  
  1111.                 if( (pident->flags&FPL_INT_VARIABLE &&
  1112.              (a==FPL_STRVARARG || a == FPL_STRARRAYVARARG)) ||
  1113.            (pident->flags&FPL_STRING_VARIABLE &&
  1114.             (a==FPL_INTVARARG || a == FPL_INTARRAYVARARG))) {
  1115.             CALL(Warn(scr, FPLERR_ILLEGAL_VARIABLE));
  1116.             /* can't copy wrong variable! */
  1117.             pass->argv[pass->argc]=NULL;
  1118.                 } else
  1119.             pass->argv[pass->argc]=(void *)pident;
  1120.  
  1121.                 pass->format[pass->argc++]=
  1122.           (pident->flags&FPL_STRING?
  1123.          (pident->data.variable.num?FPL_STRARRAYVARARG:FPL_STRVARARG):
  1124.            (pident->data.variable.num?FPL_INTARRAYVARARG:
  1125.             FPL_INTVARARG));
  1126.                 Eat(scr);
  1127.                 break;
  1128.               default:
  1129.                 CALL(Warn(scr, FPLERR_ILLEGAL_PARAMETER));
  1130.                 break; /* just ignore it and be happy! */
  1131.               }
  1132.               if(*text!=FPL_ARGLIST)
  1133.                 text++;
  1134.               if(*scr->text==CHAR_COMMA) {
  1135.                 scr->text++;
  1136.         CALL(Eat(scr)); /* eat white space! */
  1137.  
  1138.               }
  1139.             }
  1140.             pass->format[pass->argc]=CHAR_ASCII_ZERO;
  1141.             if(text && *text && !(*text&CASE_BIT)) {
  1142.               return FPLERR_MISSING_ARGUMENT;
  1143.               /*
  1144.                * This is a serious mis-use. The function is called with to few
  1145.                * parameters. At least one parameter missing is a required one.
  1146.                * I really can't figure out a way to survive such a shock!
  1147.                */
  1148.             }
  1149.           } else
  1150.             pass->format=NULL;
  1151.           if(*scr->text!=CHAR_CLOSE_PAREN) {
  1152.             CALL(Warn(scr, FPLERR_TOO_MANY_PARAMETERS)); /* too many parameters! */
  1153.             /* It's ok to continue without the parenthesis! */
  1154.           } else
  1155.             scr->text++;
  1156.  
  1157.           /*
  1158.            * Call the function!
  1159.            */
  1160.  
  1161.           CALL(CallFunction(scr, pass, ident));
  1162.  
  1163. #if 0
  1164.       fprintf(stderr, "**Return\n");
  1165. #endif
  1166.           CALL(GetMessage(scr, FPLMSG_RETURN, &msg));
  1167.           if(FPL_OPTEXPRARG == hit) {
  1168.             if(msg) {
  1169.               if(msg->flags&FPLMSG_FLG_INT) {
  1170.                 /* There is a return 'int' message! This may well be a
  1171.                    function returning int! */
  1172.                 hit = FPL_INTARG;
  1173.               }
  1174.               else {
  1175.                 /* found string, it returned a 'string' !!! */
  1176.                 hit = FPL_STRARG;
  1177.               }
  1178.             }
  1179.             /* There is no return nor hint! */
  1180.           }
  1181.  
  1182.           switch(hit) {
  1183.             case FPL_STRARG:
  1184. #if 0
  1185.           fprintf(stderr, "**String from %s\n", pass->name);
  1186.           fprintf(stderr, "**Flags %d %d\n", msg->flags&FPLMSG_FLG_BITS,
  1187.               FPLMSG_FLG_STRING);
  1188. #endif
  1189.               if(msg && ((msg->flags&FPLMSG_FLG_BITS) != FPLMSG_FLG_STRING))
  1190.                 return FPLERR_UNEXPECTED_INT_STATEMENT;
  1191.               if(!msg || !msg->message[0])
  1192.                 /* We got a zero length string or no string at all! */
  1193.                 expr->val.str=NULL; /* no string! */
  1194.               else
  1195.                 /* the copied string! */
  1196.                 expr->val.str=(struct fplStr *)msg->message[0];
  1197.             
  1198. #ifdef DEBUGMAIL
  1199.               DebugMail(scr, MAIL_RETURN_STRING, (long)pass->name,
  1200.                         expr->val.str);
  1201. #endif
  1202.               expr->flags=FPL_STRING|FPL_ACTION;
  1203.               break;
  1204.             case FPL_INTARG:
  1205.             default:
  1206. #if 0
  1207.           fprintf(stderr, "**Int from %s\n", pass->name);
  1208. #endif
  1209.               if(msg && ((msg->flags&FPLMSG_FLG_BITS) != FPLMSG_FLG_INT))
  1210.                 return FPLERR_UNEXPECTED_STRING_STATEMENT;
  1211.               /* only if integer! or the function is non-existent */
  1212.               expr->val.val=(msg?(long)msg->message[0]:0);
  1213. #ifdef DEBUGMAIL
  1214.               DebugMail(scr, MAIL_RETURN_INTEGER, (long)pass->name,
  1215.                         (void *)expr->val.val);
  1216. #endif
  1217.               CALL(NewMember(scr, &expr));
  1218.               break;
  1219.           }
  1220.           if(msg)
  1221.             DeleteMessage(scr, msg);
  1222.  
  1223.           if(!ident) {
  1224.             /*
  1225.              * The function we invoked was not found regularly!
  1226.          * Free the name we allocated temporarily.
  1227.          */
  1228.             FREE(pass->name); /* the name was strdup()'ed! */
  1229.       }
  1230.  
  1231.           while(pass->argc--) {
  1232.             if(pass->format[pass->argc]==FPL_STRARG && array[pass->argc]) {
  1233.               /* free the string if it's been marked to be freed!! */
  1234.               FREE((uchar *)pass->argv[pass->argc]-
  1235.                    offsetof(struct fplStr, string));
  1236.             }
  1237.           }
  1238.           if(pass->format) {
  1239.             FREE(pass->argv);
  1240.             FREE(pass->format);
  1241.             FREE(array);
  1242.           }
  1243.           FREE(pass);
  1244.         }
  1245.       } else {
  1246.  
  1247.           pos=0;
  1248.           switch(*scr->text) {
  1249.       case CHAR_MULTIPLY:
  1250.         /*
  1251.          * This is the 'contents of' operator!
  1252.          * The contents of the variable that follows this sign should
  1253.          * get the following rvalue.
  1254.          * Of course, we must first check that this really is a
  1255.          * 'pointer' to a variable.
  1256.          * If we declare this, make sure that it doesn't point to
  1257.          * anything at all!
  1258.          */
  1259.  
  1260.         while(*++scr->text==CHAR_MULTIPLY); /* just in case! */
  1261.  
  1262.         CALL(Getword(scr));
  1263.         if(control&CON_DECLARE) {
  1264.           return FPLERR_SYNTAX_ERROR; /* not yet supported */
  1265.         }
  1266.         else {
  1267.               CALL(GetIdentifier(scr, scr->buf, &ident));
  1268.           if(!(ident->flags&FPL_REFERENCE))
  1269.             return FPLERR_ILLEGAL_REFERENCE; /* referenced a non-reference! */
  1270.           if(!ident->data.variable.ref)
  1271.         return FPLERR_ILLEGAL_REFERENCE; /* illegal reference! */
  1272.  
  1273.           ident = ident->data.variable.ref; /* use the "actual" variable! */
  1274.  
  1275.           /* we have an identifier and the level is OK! */
  1276.           control |= CON_IDENT|CON_LEVELOK;
  1277.           continue; /* now we have the pointer for the *real* variable! */
  1278.         }
  1279.         break;
  1280.           case CHAR_ZERO:
  1281.             /*
  1282.              * Numbers starting with a '0' can be hex/oct/bin.
  1283.              */
  1284.             if(control&CON_STRING) {
  1285.               /* NO integers allowed! */
  1286.               return FPLERR_UNEXPECTED_INT_STATEMENT;
  1287.             }
  1288.             switch(scr->text[1]) {
  1289.             case CHAR_X:
  1290.             case CHAR_UPPER_X:
  1291.               /* hexadecimal number parser */
  1292.               for(scr->text+=2; isxdigit(*scr->text); scr->text++)
  1293.                 expr->val.val=expr->val.val*16+ (isdigit(*scr->text)?
  1294.                                          *scr->text-CHAR_ZERO:
  1295.                                          UPPER(*scr->text)-CHAR_UPPER_A+10);
  1296.               break;
  1297.             case CHAR_B:
  1298.             case CHAR_UPPER_B:
  1299.               /* binary number parser */
  1300.               for(scr->text+=2;*scr->text==CHAR_ZERO || *scr->text==CHAR_ONE;)
  1301.                 expr->val.val=expr->val.val*2+ *scr->text++ - CHAR_ZERO;
  1302.               break;
  1303.             case CHAR_ZERO:
  1304.             case CHAR_ONE:
  1305.             case CHAR_TWO:
  1306.             case CHAR_THREE:
  1307.             case CHAR_FOUR:
  1308.             case CHAR_FIVE:
  1309.             case CHAR_SIX:
  1310.             case CHAR_SEVEN:
  1311.               /* octal number parser */
  1312.               for(scr->text++; isodigit(*scr->text);)
  1313.                 expr->val.val=expr->val.val*8+ *scr->text++ - CHAR_ZERO;
  1314.               break;
  1315.             default:
  1316.               /* a single zero is simply 0 */
  1317.               scr->text++;
  1318.               expr->val.val=0;
  1319.               break;
  1320.             }
  1321.             CALL(NewMember(scr, &expr));
  1322.             break;
  1323.         /* end of case CHAR_ZERO: */
  1324.  
  1325.           case CHAR_ONE:
  1326.           case CHAR_TWO:
  1327.           case CHAR_THREE:
  1328.           case CHAR_FOUR:
  1329.           case CHAR_FIVE:
  1330.           case CHAR_SIX:
  1331.           case CHAR_SEVEN:
  1332.           case CHAR_EIGHT:
  1333.           case CHAR_NINE:
  1334.             /*
  1335.              * We hit a number between 1 and 9.
  1336.              */
  1337.             if(control&CON_STRING) {
  1338.               /* NO integers allowed! */
  1339.               CALL(Warn(scr, FPLERR_UNEXPECTED_INT_STATEMENT));
  1340.             }
  1341.             do
  1342.               expr->val.val= expr->val.val*10 + *scr->text++ - CHAR_ZERO;
  1343.             while(isdigit(*scr->text));
  1344.             CALL(NewMember(scr, &expr));
  1345.         break;
  1346.  
  1347.         case CHAR_QUOTATION_MARK:
  1348.             if(control&CON_NUM) {
  1349.               /* NO integers allowed! */
  1350.               CALL(Warn(scr, FPLERR_UNEXPECTED_STRING_STATEMENT));
  1351.             }
  1352.             CALL(Convert(val, scr));
  1353.             /* This returned a string! */
  1354.             expr->val.str=val->val.str;
  1355.             expr->flags=FPL_STRING;
  1356.         CALL(StringExpr(expr, scr));
  1357.         break;
  1358.  
  1359.         case CHAR_APOSTROPHE:
  1360.             /*
  1361.              * Apostrophes surround character. Returns ASCII code.
  1362.              */
  1363.             if(control&CON_STRING) {
  1364.               /* NO integers allowed! */
  1365.               CALL(Warn(scr, FPLERR_UNEXPECTED_INT_STATEMENT));
  1366.             }
  1367.             CALL(ReturnChar((scr->text++, scr), &expr->val.val, FALSE));
  1368.             if(*scr->text!=CHAR_APOSTROPHE) {
  1369.               CALL(Warn(scr, FPLERR_MISSING_APOSTROPHE)); /* >warning< */
  1370.               /* just continue as nothing has ever happened! */
  1371.             } else
  1372.               scr->text++;
  1373.             CALL(NewMember(scr, &expr));
  1374.         break;
  1375.  
  1376.         case CHAR_OPEN_PAREN:
  1377.             CALL(Expression(val, (++scr->text, scr), CON_GROUNDLVL|CON_NUM, NULL));
  1378.             if(*scr->text!=CHAR_CLOSE_PAREN) {
  1379.               CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
  1380.               /* Go on anyway! */
  1381.             } else
  1382.               scr->text++;
  1383.             expr->val.val=val->val.val;
  1384.             CALL(NewMember(scr, &expr));
  1385.             break;
  1386.  
  1387.         case CHAR_NOT_OPERATOR:
  1388.             CALL(AddUnary(scr, expr, OP_NOT));
  1389.             ++scr->text;
  1390.             break;
  1391.  
  1392.         case CHAR_ONCE_COMPLEMENT:
  1393.             CALL(AddUnary(scr, expr, OP_COMPL));
  1394.             ++scr->text;
  1395.           break;
  1396.  
  1397.         case CHAR_PLUS:
  1398.             if(scr->text[1]==CHAR_PLUS) {
  1399.               expr->flags|=FPL_ACTION;
  1400.               scr->text+=2;
  1401.               CALL(AddUnary(scr, expr, OP_PREINC));
  1402.             } else {
  1403.               CALL(AddUnary(scr, expr, OP_PLUS));
  1404.               scr->text++;
  1405.             }
  1406.             break;
  1407.  
  1408.         case CHAR_MINUS:
  1409.             if(scr->text[1]==CHAR_MINUS) {
  1410.               expr->flags|=FPL_ACTION;
  1411.               scr->text+=2;
  1412.               CALL(AddUnary(scr, expr, OP_PREDEC));
  1413.             } else {
  1414.               CALL(AddUnary(scr, expr, OP_MINUS));
  1415.               scr->text++;
  1416.             }
  1417.             break;
  1418.  
  1419.           default:
  1420.  
  1421.             if((*scr->text==CHAR_SEMICOLON && control&CON_SEMICOLON) ||
  1422.                (*scr->text==CHAR_CLOSE_PAREN && control&CON_PAREN)
  1423.                && basexpr==expr && expr->operator==OP_NOTHING) {
  1424.               /* for(;;) support.
  1425.                  There must not have been a previous operand or operator */
  1426.               pos=expr->val.val=TRUE;
  1427.             } else {   /* no operand results in error! */
  1428.               CALL(Warn(scr, FPLERR_MISSING_OPERAND)); /* WARNING! */
  1429.               expr->operator=OP_NOTHING; /* reset */
  1430.             }
  1431.           break;
  1432.       }
  1433.           if(pos)
  1434.           break;
  1435.       }
  1436.  
  1437.     } else {                                         /* waiting for operator */
  1438.       uchar *point=scr->text;
  1439.  
  1440.       switch(*scr->text) {
  1441.       case CHAR_ASSIGN:
  1442.         if(scr->text[1]==CHAR_ASSIGN) {
  1443.           expr->operator=OP_EQUAL;
  1444.           scr->text+=2;
  1445.         }
  1446.         break;
  1447.       case CHAR_AND:
  1448.     if(scr->text[1]==CHAR_AND) {
  1449.           /*
  1450.            * This is a logical AND (&&)
  1451.            */
  1452.           scr->text+=2;
  1453.  
  1454.           /*
  1455.            * Get result from everything to the left of this!
  1456.            */
  1457.           CALL(Calc(scr, val, basexpr));
  1458.  
  1459.           /*
  1460.            * Clean the expression so far.
  1461.            */
  1462.           Clean(scr, basexpr);    /* erase the list */
  1463.  
  1464.           /*
  1465.            * Start a new list with this result
  1466.            */
  1467.           GETMEM(expr, sizeof(struct Expr));
  1468.           memset(expr, 0, sizeof(struct Expr));
  1469.           basexpr=expr;
  1470.           expr->val.val = val->val.val;
  1471.  
  1472.           if(!expr->val.val) {
  1473.             /*
  1474.              * In this case, its like in the 'a && b' expression and 'a'
  1475.              * equals 0. Then we should skip the 'b' expression.
  1476.              */
  1477.             CALL(ScanForNext(scr, OP_LOGAND));
  1478.             expr->flags = FPL_OPERAND;
  1479.           }
  1480.           continue;
  1481.  
  1482.         } else {
  1483.           expr->operator=OP_BINAND;
  1484.           scr->text++;
  1485.         }
  1486.         break;
  1487.       case CHAR_OR:
  1488.         if(scr->text[1]==CHAR_OR) {
  1489.           /*
  1490.            * This is a logical OR operator (||)
  1491.            */
  1492.           scr->text+=2;
  1493.  
  1494.           /*
  1495.            * Get result from everything to the left of this!
  1496.            */
  1497.           CALL(Calc(scr, val, basexpr));
  1498.  
  1499.           /*
  1500.            * Clean the expression so far.
  1501.            */
  1502.           Clean(scr, basexpr);    /* erase the list */
  1503.  
  1504.           /*
  1505.            * Start a new list with this result
  1506.            */
  1507.           GETMEM(expr, sizeof(struct Expr));
  1508.           memset(expr, 0, sizeof(struct Expr));
  1509.           basexpr=expr;
  1510.           expr->val.val = val->val.val;
  1511.  
  1512.           if(expr->val.val) {
  1513.             /*
  1514.              * In this case, its like in the 'a || b' expression and 'a'
  1515.              * equals 1. Then we should skip the 'b' expression.
  1516.              */
  1517.             CALL(ScanForNext(scr, OP_LOGOR));
  1518.             expr->flags = FPL_OPERAND;
  1519.           }
  1520.           continue;
  1521.  
  1522.         } else {
  1523.           expr->operator=OP_BINOR;
  1524.           scr->text++;
  1525.         }
  1526.         break;
  1527.       case CHAR_PLUS:
  1528.         expr->operator=OP_PLUS;
  1529.         ++scr->text;
  1530.         break;
  1531.       case CHAR_MINUS:
  1532.         expr->operator=OP_MINUS;
  1533.         ++scr->text;
  1534.         break;
  1535.       case CHAR_QUESTION:
  1536.         ++scr->text;
  1537.         /*
  1538.          * This is the first operator in a conditional operator sequence (?)
  1539.          */
  1540.  
  1541.         /*
  1542.          * Get result from everything to the left of this!
  1543.          */
  1544.         CALL(Calc(scr, val, basexpr));
  1545.  
  1546.         /*
  1547.          * Clean the expression so far.
  1548.          */
  1549.         Clean(scr, basexpr);    /* erase the list */
  1550.  
  1551.         /*
  1552.          * Start a new list with this result
  1553.          */
  1554.         GETMEM(expr, sizeof(struct Expr));
  1555.         memset(expr, 0, sizeof(struct Expr));
  1556.         expr->flags = FPL_OPERAND;
  1557.         basexpr=expr;
  1558.  
  1559.         if(val->val.val) {
  1560.           /*
  1561.            * In this case, its like in the 'a ? b : c' expression and 'a'
  1562.            * equals 1. Then we should skip the 'c' expression.
  1563.            */
  1564.           CALL(Expression(val, scr, CON_NORMAL, NULL));
  1565.           if(*scr->text++!=CHAR_COLON)
  1566.             return FPLERR_ILLEGAL_CONDOP;
  1567.           CALL(ScanForNext(scr, OP_COND2));          
  1568.         }
  1569.         else {
  1570.           /*
  1571.            * In this case, its like in the 'a ? b : c' expression and 'a'
  1572.            * equals 0. Then we should skip the 'b' expression.
  1573.            */
  1574.           CALL(ScanForNext(scr, OP_COND1));
  1575.           if(*scr->text++!=CHAR_COLON)
  1576.             return FPLERR_ILLEGAL_CONDOP;
  1577.           CALL(Expression(val, scr, CON_NORMAL, NULL));
  1578.         }
  1579.         expr->val.val = val->val.val;
  1580.         continue; /* check for next operator */
  1581.  
  1582.         break;
  1583. #if 0
  1584.       case CHAR_COLON:
  1585.         if(conditional) {
  1586.           /* only if preceeded with the regular '?' operator! */
  1587.       conditional--;
  1588.           expr->operator=OP_COND2;
  1589.           ++scr->text;
  1590.         }
  1591.         break;
  1592. #endif
  1593.       case CHAR_MULTIPLY:
  1594.         expr->operator=OP_MULTIPLY;
  1595.         ++scr->text;
  1596.         break;
  1597.       case CHAR_DIVIDE:
  1598.         expr->operator=OP_DIVISION;
  1599.         ++scr->text;
  1600.         break;
  1601.       case CHAR_REMAIN:
  1602.         expr->operator=OP_REMAIN;
  1603.         ++scr->text;
  1604.         break;
  1605.       case CHAR_XOR:
  1606.         expr->operator=OP_BINXOR;
  1607.         ++scr->text;
  1608.         break;
  1609.       case CHAR_LESS_THAN:
  1610.         if(scr->text[1]==CHAR_ASSIGN) {
  1611.           scr->text+=2;
  1612.           expr->operator=OP_LESSEQ;
  1613.         } else if(scr->text[1]==CHAR_LESS_THAN) {
  1614.           scr->text+=2;
  1615.           expr->operator=OP_SHIFTL;
  1616.         } else {
  1617.           scr->text++;
  1618.           expr->operator=OP_LESS;
  1619.         }
  1620.         break;
  1621.       case CHAR_GREATER_THAN:
  1622.     if(scr->text[1]==CHAR_ASSIGN) {
  1623.           expr->operator= OP_GRETEQ;
  1624.           scr->text+=2;
  1625.         } else if(scr->text[1]==CHAR_GREATER_THAN) {
  1626.           scr->text+=2;
  1627.           expr->operator=OP_SHIFTR;
  1628.         } else {
  1629.           scr->text++;
  1630.           expr->operator=OP_GRET;
  1631.         }
  1632.         break;
  1633.       case CHAR_NOT_OPERATOR:
  1634.         if(scr->text[1]==CHAR_ASSIGN) {
  1635.           expr->operator=OP_NOTEQ;
  1636.           scr->text+=2;
  1637.         }
  1638.         break;
  1639.       case CHAR_COMMA:
  1640.         if(control&CON_GROUNDLVL) {
  1641.           Clean(scr, basexpr);
  1642.           GETMEM(basexpr, sizeof(struct Expr));
  1643.           expr=basexpr;
  1644.           expr->val.val=0;
  1645.           expr->unary=NULL;
  1646.           expr->operator=expr->flags=OP_NOTHING;
  1647.           expr->next=NULL;
  1648.           scr->text++;
  1649.         }
  1650.         break;
  1651.       }
  1652.       if(point==scr->text)
  1653.         break;
  1654.       expr->flags&=~FPL_OPERAND; /* clear the operand bit */
  1655.     }
  1656.   } while(1);
  1657.  
  1658.   if(!(control&(CON_DECLARE /* |CON_ACTION */ ))) {
  1659.     /*
  1660.      * Get result of the current expression only if this isn't called
  1661.      * as a declaring (no one wants the return code from 'int a'!)
  1662.      * or a stand-alone (they have no receiver anyway) statement.
  1663.      */
  1664.     CALL(Calc(scr, val, basexpr));
  1665.  
  1666.     /*
  1667.      * If this was a stand alone statement, including no action returns an
  1668.      * error!
  1669.      */
  1670.     if(control&CON_ACTION && !(val->flags&FPL_ACTION)) {
  1671.       CALL(Warn(scr, FPLERR_NO_ACTION));
  1672.       /* but we can just as good keep on anyway! */
  1673.     }
  1674.   }
  1675.  
  1676.   Clean(scr, basexpr);    /* erase the rest of the list */
  1677.   if(dims)
  1678.     FREE(dims);
  1679.   return(FPL_OK);
  1680. }
  1681.  
  1682. /**********************************************************************
  1683.  *
  1684.  * ReturnCode Calc();
  1685.  *
  1686.  * Returns the result in the first Expr struct of the expression that
  1687.  * the second parameter holds. This function does not free the expression
  1688.  * list.
  1689.  *
  1690.  *******/
  1691.  
  1692. static ReturnCode
  1693. Calc(struct Data *scr,
  1694.      struct Expr *val,
  1695.      struct Expr *basexpr)
  1696. {
  1697.   /* lower value=higher priority. Order as the operator list in script.h:
  1698.    *|    +  -  /  * << >>  %  &  |  ^ && ||  ~    ?   :  == <= >=  <  > != ! */
  1699.   const static uchar priority[]={
  1700.     255, 1, 1, 0, 0, 2, 2, 0, 5, 7, 6, 8, 9, 255, 10, 10, 4, 3, 3, 3, 3, 4, 255
  1701.     };
  1702.  
  1703.   ReturnCode ret;
  1704.   uchar pri, minpri=255, maxpri=0;
  1705.   struct Expr *expr=basexpr, *last;
  1706.   struct Unary *un, *next;
  1707.  
  1708.   /* first all Unary expressions */
  1709.   if(!(expr->flags&FPL_STRING)) {
  1710.     while(expr) {
  1711.       if(priority[expr->operator]<minpri)
  1712.         minpri=priority[expr->operator]; /* get the lowest priority */
  1713.       if(priority[expr->operator]>maxpri && expr->operator!=OP_NOTHING)
  1714.         maxpri=priority[expr->operator]; /* get the highest priority */
  1715.       if(expr->flags&FPL_STRING) {
  1716.         CALL(Warn(scr, FPLERR_ILLEGAL_VARIABLE));
  1717.         /*
  1718.          * A string among the integers!
  1719.          * We remove this and try next!
  1720.          */
  1721.  
  1722.         last=expr->next;
  1723.         FREE(expr); /* delete this bastard from the expression!!! */
  1724.         expr=last;
  1725.       } else {
  1726.         un=expr->unary;
  1727.         while(un) {
  1728.           switch(un->unary) {
  1729.           case OP_NOT:
  1730.             expr->val.val=!expr->val.val;
  1731.             break;
  1732.           case OP_COMPL:
  1733.             expr->val.val=~expr->val.val;
  1734.             break;
  1735.           case OP_MINUS:
  1736.             expr->val.val=-expr->val.val;
  1737.             break;
  1738.             /*simply ignored!
  1739.               case OP_PLUS:
  1740.               break;
  1741.               */
  1742.           case OP_PREDEC:
  1743.           case OP_PREINC:
  1744.             CALL(Warn(scr, FPLERR_ILLEGAL_PREOPERATION));
  1745.             /* just ignore it! */
  1746.           }
  1747.           next=un->next;
  1748.           FREE(un);
  1749.           un=next;
  1750.         }
  1751.       }
  1752.       expr=expr->next;
  1753.     }
  1754.   }
  1755.   /*
  1756.    * Calculate all members of the linked list in the proper way and put
  1757.    * the result in "val->val.val" before returning "ret". Check for operators
  1758.    * with priority within `minpri' and `maxpri' which we got in the loop
  1759.    * above.
  1760.    *
  1761.    * Check priority level by priority level and perform the right actions.
  1762.    * When reaching the maxpri, there is only one number left: the result!
  1763.    */
  1764.  
  1765.   for(pri=minpri; pri<=maxpri; pri++) {
  1766.     last=expr=basexpr;
  1767.     while(expr=expr->next) {
  1768.       if(priority[expr->operator]==pri) {
  1769.         last->flags|=expr->flags;
  1770.         switch(expr->operator) {
  1771.         case OP_MULTIPLY:
  1772.           last->val.val*=expr->val.val;
  1773.           break;
  1774.         case OP_DIVISION:
  1775.           if(!expr->val.val) {
  1776.             CALL(Warn(scr, FPLERR_DIVISION_BY_ZERO));
  1777.             /* we give a zero as result! */
  1778.             last->val.val=0;
  1779.           } else
  1780.             last->val.val/=expr->val.val;
  1781.           break;
  1782.         case OP_REMAIN:
  1783.           if(!expr->val.val) {
  1784.             CALL(Warn(scr, FPLERR_DIVISION_BY_ZERO));
  1785.             last->val.val=0;
  1786.           } else
  1787.             last->val.val%=expr->val.val;
  1788.           break;
  1789.         case OP_SHIFTL:
  1790.           last->val.val<<=expr->val.val;
  1791.           break;
  1792.         case OP_SHIFTR:
  1793.           last->val.val>>=expr->val.val;
  1794.           break;
  1795.         case OP_BINAND:
  1796.           last->val.val&=expr->val.val;
  1797.           break;
  1798.         case OP_BINOR:
  1799.           last->val.val|=expr->val.val;
  1800.           break;
  1801.         case OP_BINXOR:
  1802.           last->val.val^=expr->val.val;
  1803.           break;
  1804.         case OP_PLUS:
  1805.           last->val.val+=expr->val.val;
  1806.           break;
  1807.         case OP_MINUS:
  1808.           last->val.val-=expr->val.val;
  1809.           break;
  1810.         case OP_EQUAL:
  1811.           last->val.val=last->val.val==expr->val.val;
  1812.           break;
  1813.         case OP_NOTEQ:
  1814.           last->val.val=last->val.val!=expr->val.val;
  1815.           break;
  1816.         case OP_LESSEQ:
  1817.           last->val.val=last->val.val<=expr->val.val;
  1818.           break;
  1819.         case OP_LESS:
  1820.           last->val.val=last->val.val<expr->val.val;
  1821.           break;
  1822.         case OP_GRETEQ:
  1823.           last->val.val=last->val.val>=expr->val.val;
  1824.           break;
  1825.         case OP_GRET:
  1826.           last->val.val=last->val.val>expr->val.val;
  1827.           break;
  1828.         case OP_LOGOR:
  1829.           last->val.val=last->val.val||expr->val.val;
  1830.           break;
  1831.         case OP_LOGAND:
  1832.           last->val.val=last->val.val&&expr->val.val;
  1833.           break;
  1834.         case OP_COND1:
  1835.           if(expr->next && expr->next->operator==OP_COND2) {
  1836.             last->val.val=last->val.val?expr->val.val:expr->next->val.val;
  1837.           } else {
  1838.             CALL(Warn(scr, FPLERR_ILLEGAL_CONDOP)); /* WARNING! */
  1839.             last->val.val=expr->val.val; /* get the number we have! */
  1840.           }
  1841.           break;
  1842.         }
  1843.         last->next=expr->next;
  1844.         FREE(expr);
  1845.         expr=last;
  1846.       } else
  1847.         last=expr;
  1848.     }
  1849.   }
  1850.   val->val.val=basexpr->val.val; /* get the final value */
  1851.   val->flags=basexpr->flags; /* copy the flags */
  1852.   return(FPL_OK);
  1853. }
  1854.  
  1855. /**********************************************************************
  1856.  *
  1857.  * AddUnary();
  1858.  *
  1859.  * Build a linked list on the unary member of the Expr struct!
  1860.  *
  1861.  ******/
  1862.  
  1863. static ReturnCode
  1864. AddUnary(struct Data *scr,
  1865.          struct Expr *expr,
  1866.          Operator unary)
  1867. {
  1868.   struct Unary *next=expr->unary;
  1869.  
  1870.   GETMEM(expr->unary, sizeof(struct Unary));
  1871.   expr->unary->unary=unary;
  1872.   expr->unary->next=next;
  1873.  
  1874.   return(FPL_OK);
  1875. }
  1876.  
  1877.  
  1878. /**********************************************************************
  1879.  *
  1880.  * Clean()
  1881.  *
  1882.  * Erases every track of the linked TalStruct list...
  1883.  *
  1884.  ******/
  1885.  
  1886. static void Clean(struct Data *scr, struct Expr *basexpr)
  1887. {
  1888.   struct Expr *last;
  1889.   while(basexpr) {
  1890.     last=basexpr->next;
  1891.     FREE(basexpr);
  1892.     basexpr=last;
  1893.   }
  1894. }
  1895.  
  1896. /**********************************************************************
  1897.  *
  1898.  * Convert()
  1899.  *
  1900.  * Converts the following "string" in the line to a string which it returns.
  1901.  *
  1902.  *********/
  1903.  
  1904. static ReturnCode INLINE Convert(struct Expr *expr, struct Data *scr)
  1905. {
  1906.   ReturnCode ret=FPL_OK;
  1907.   long a;
  1908.   unsigned long pos=0;  /* start position */
  1909.  
  1910.   struct fplStr *pointer, *pek;
  1911.  
  1912.   expr->flags|=FPL_STRING;
  1913.  
  1914. #ifdef STRING_STACK
  1915.   /*
  1916.      First, check with the static string stack to see if this string
  1917.      has already been parsed and is ready to simply restore.
  1918.      Put this string as most recently restored.
  1919.    */
  1920.  
  1921.   /*
  1922.      StringFromStack() uses the scr->text pointer to determine which string
  1923.      we want to have. It also moves our program pointer to the end of the
  1924.      string if it is there.
  1925.    */
  1926.   if(scr->strings_in_stack_max>0) {
  1927.     CALL(StringFromStack(scr, &pointer));
  1928.     if(pointer) {
  1929.       expr->val.str=pointer;
  1930.       expr->flags|=FPL_NOFREE|FPL_STACKED;
  1931.       return FPL_OK;
  1932.     }
  1933.   }
  1934. #endif
  1935.  
  1936.   GETMEM(pointer, sizeof(struct fplStr) + ADDSTRING_DEFAULT);
  1937.   /* create default string space */
  1938.  
  1939.   pointer->alloc=ADDSTRING_DEFAULT;
  1940.   pointer->len=0;
  1941.  
  1942.   expr->val.str=pointer;
  1943.  
  1944. #ifdef DEBUG
  1945.   CheckMem(scr, pointer);
  1946. #endif
  1947.   do {
  1948.     scr->text++;
  1949.     while(*scr->text!=CHAR_QUOTATION_MARK) {
  1950.       CALL(ReturnChar(scr, &a, TRUE));
  1951.       if(a<256) {
  1952.         pointer->string[pos]=a;
  1953.         if(++pos>=pointer->alloc) {
  1954.           GETMEM(pek, (pointer->alloc+=ADDSTRING_INC)+sizeof(struct fplStr));
  1955.           memcpy(pek, pointer, pos+sizeof(struct fplStr));
  1956.           FREE(pointer);
  1957.           pointer=pek;
  1958.           expr->val.str=pointer;
  1959.         }
  1960.       }
  1961.     }
  1962.     scr->text++;
  1963.     CALL(Eat(scr));
  1964.   } while(*scr->text==CHAR_QUOTATION_MARK);
  1965.   pointer->string[pos]=0; /* zero terminate */
  1966.   pointer->len=pos;       /* length of string */
  1967.   expr->val.str=pointer;
  1968. #ifdef STRING_STACK
  1969.   /*
  1970.      We push our newly scanned string on the string stack. Very useful if
  1971.      this string is reffered in i.e a loop.
  1972.    */
  1973.   if(scr->strings_in_stack_max>0) {
  1974.     CALL(StringToStack(scr, &pointer));
  1975.     if(pointer)
  1976.       /* no one may free a string in the stack! */
  1977.       expr->flags|=FPL_NOFREE|FPL_STACKED;
  1978.   }
  1979. #endif
  1980.  
  1981.   return(ret);
  1982. }
  1983.  
  1984. #ifdef STRING_STACK
  1985. static ReturnCode INLINE StringToStack(struct Data *scr,
  1986.                                        struct fplStr **string)
  1987. {
  1988.   if(scr->stringstackptr >= scr->strings_in_stack_max) {
  1989.     FREE(scr->stringkeeper[ 0 ]); /* free the previous holder of that position! */
  1990.     scr->stringstackptr = 0;
  1991.   } else
  1992.     scr->strings_in_stack_now++;
  1993.  
  1994.   scr->stringstack[ current_entry ].string = *string;
  1995.   scr->stringstack[ current_entry ].text = scr->text;
  1996.   scr->stringstack[ current_entry ].prg = scr->prg;
  1997.   scr->stringstack[ current_entry ].virprg = scr->virprg;
  1998.   scr->stringstackptr++;
  1999. }
  2000.  
  2001. static ReturnCode INLINE StringFromStack(struct Data *scr,
  2002.                                          struct fplStr **string)
  2003. {
  2004.   const long num = scr->stringstackptr;
  2005.   const long max = scr->strings_in_stack_max;
  2006.   long count;
  2007.   for(count=0; count<scr->strings_in_stack_now; count++) {
  2008.     if(scr->stringprogram[ (num-count) >= 0 ?
  2009.                            num-count :
  2010.                            max-count] == scr->text) {
  2011.       *string = scr->stringstack[ count ].string;
  2012.       scr->text = scr->stringstack[ count ].text;
  2013.       scr->prg = scr->stringstack[ count ].prg;
  2014.       scr->virprg = scr->stringstack[ count ].virprg;
  2015.       return FPL_OK;
  2016.     }
  2017.   }
  2018.   *string=NULL;
  2019.   return FPL_OK;
  2020. }
  2021.  
  2022. #endif
  2023.  
  2024. /**********************************************************************
  2025.  *
  2026.  * GetArrayInfo()
  2027.  *
  2028.  * Read the []'s and store the information. Make sure you're standing on
  2029.  * the open bracket!
  2030.  *
  2031.  * Set the int num points to, to any number if you want to limit the number
  2032.  * of dimension reads.
  2033.  */
  2034.  
  2035. static ReturnCode INLINE GetArrayInfo(struct Data *scr,
  2036.                                       long *dims,  /* long array */
  2037.                                       long *num,   /* number of dims */
  2038.                                       long control,
  2039.                                       uchar *name)  /* variable name */
  2040. {
  2041.   struct Expr *val;
  2042.   ReturnCode ret=FPL_OK;
  2043.   long maxnum=*num;
  2044.   GETMEM(val, sizeof(struct Expr));
  2045.   *num=0;
  2046.   if(*scr->text==CHAR_OPEN_BRACKET) {
  2047.     do {
  2048.       scr->text++; /* pass the open bracket */
  2049.       /* eval the expression: */
  2050.       CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  2051.  
  2052.       if(*scr->text!=CHAR_CLOSE_BRACKET) {
  2053.         /* no close bracket means error */
  2054.         CALL(Warn(scr, FPLERR_MISSING_BRACKET)); /* >warning< */
  2055.         /* go on anyway! */
  2056.       } else
  2057.         scr->text++;
  2058.  
  2059.       if(val->val.val<(control&CON_DECLARE?1:0)) {
  2060.         /* illegal result of the expression */
  2061.         /*
  2062.          * Write back the original variable name to the buffer!
  2063.          */
  2064.         strcpy(scr->buf, name);
  2065.         ret = FPLERR_ILLEGAL_ARRAY;
  2066.         break;
  2067.       }
  2068.  
  2069.       dims[(*num)++]=val->val.val; /* Add another dimension */
  2070.       if(*num==maxnum) {
  2071.         /* we've hit the roof! */
  2072.         break;
  2073.       } else if(*num==MAX_DIMS) {
  2074.         /* if we try to use too many dimensions... */
  2075.         ret=FPLERR_ILLEGAL_ARRAY;
  2076.         /*
  2077.          * Write back the original variable name to the buffer!
  2078.          */
  2079.         strcpy(scr->buf, name);
  2080.         break;
  2081.       }
  2082.       /*
  2083.        * Go on as long there are braces and we are declaring OR
  2084.        * as long the `num' variable tells us (you, know: when
  2085.        * you want to read character five in a member of a
  2086.        * three dimensional string array, it could look like
  2087.        * "int a=string[2][3][4][5];" ... :-)
  2088.        */
  2089.     } while(*scr->text==CHAR_OPEN_BRACKET);
  2090.   }
  2091.   FREE(val);
  2092.   return(ret);
  2093. }
  2094.  
  2095. /**********************************************************************
  2096.  *
  2097.  * ArrayNum()
  2098.  *
  2099.  * Return which array position we should look in when the user wants the
  2100.  * array member presented as a number of dimensions and an array with the
  2101.  * dimension sizes.
  2102.  *
  2103.  ******/
  2104.  
  2105. long REGARGS
  2106. ArrayNum(long num,     /* number of dimensions specified */
  2107.          long dnum,    /* number of dimensions declared  */
  2108.          long *dims,   /* dimensions specified */
  2109.          long *decl)   /* declared dimension information */
  2110. {
  2111.   long i;
  2112.   long pos=0;
  2113.   long base=1;
  2114.   if(num!=dnum)
  2115.     /*
  2116.      * Then we can't get proper information!!!
  2117.      */
  2118.     return(-1);
  2119.   for(i=0; i<num; i++) {
  2120.     if(dims[i]>=decl[i])
  2121.       return(-1);
  2122.  
  2123.     pos+=dims[i]*base;
  2124.     base*=decl[i];
  2125.   }
  2126.   return(pos);
  2127. }
  2128.  
  2129.  
  2130. /**********************************************************
  2131.  *
  2132.  * CallFunction()
  2133.  *
  2134.  * Calls a function. Internal, external or inside!!
  2135.  *
  2136.  *******/
  2137.  
  2138. static ReturnCode INLINE CallFunction(struct Data *scr,
  2139.                                       struct fplArgument *pass,
  2140.                                       struct Identifier *ident)
  2141. {
  2142.   ReturnCode ret;
  2143.   if(ident && ident->flags&FPL_INSIDE_FUNCTION) {
  2144.     CALL(inside(scr, pass, ident));
  2145.   } else if(ident && ident->flags&FPL_INTERNAL_FUNCTION) {
  2146.     CALL(functions(pass));
  2147.   } else { /* if (EXTERNAL_FUNCTION) */
  2148.     pass->funcdata=ident?ident->data.external.data:(void *)NULL;
  2149.  
  2150. #if defined(AMIGA) && defined(SHARED)
  2151.     if(ret=CheckStack(scr, scr->stack_limit, scr->stack_margin)) {
  2152.       if(ret==1)
  2153.         return(FPLERR_OUT_OF_MEMORY);
  2154.       else
  2155.         return(FPLERR_OUT_OF_STACK);
  2156.     }
  2157. #endif
  2158.  
  2159.     if(ident && ident->data.external.func) {
  2160.       /*
  2161.        * If this is non-zero, a function specific function pointer
  2162.        * has been assigned to it! In that case we should call that
  2163.        * function instead of the traditional, global one!
  2164.        */
  2165.       CALL(InterfaceCall(scr, pass, ident->data.external.func));
  2166.     } else {
  2167.       CALL(InterfaceCall(scr, pass, scr->function));
  2168.     }
  2169.  
  2170.   }
  2171.   return(FPL_OK);
  2172. }
  2173.  
  2174. /**********************************************************************
  2175.  *
  2176.  * inside();
  2177.  *
  2178.  * This function takes care of the inside function callings within a
  2179.  * FPL program (or in a FPL program where the function was declared using
  2180.  * `export').
  2181.  *
  2182.  ******/
  2183.  
  2184. static ReturnCode INLINE inside(struct Data *scr,
  2185.                                 struct fplArgument *arg,
  2186.                                 struct Identifier *func)
  2187. {
  2188.   /*
  2189.    * The function has been declared as an `inside' one.
  2190.    */
  2191.  
  2192.   ReturnCode ret=FPL_OK;
  2193.   struct Identifier *pident; /* pointer to identifier */
  2194.   struct Identifier *ident;
  2195.   uchar *t=scr->text;
  2196.   struct Local *locals=NULL;
  2197.   long p=scr->prg;
  2198.   uchar *file=scr->prog->name;
  2199.   long vp=scr->virprg;
  2200.   uchar *vf=scr->virfile;
  2201.   uchar count; /* parameter counter */
  2202.   uchar *text;
  2203.   struct Condition con;
  2204.   struct Expr *val;
  2205.   struct fplStr *string;
  2206.   uchar oldret;
  2207.   static unsigned long inttags[]={FPLSEND_INT, 0, FPLSEND_DONE};
  2208.   static unsigned long strtags[]={FPLSEND_STRING, 0, FPLSEND_STRLEN, 0,
  2209.                                   FPLSEND_DONTCOPY_STRING, TRUE,
  2210.                                   FPLSEND_DONE};
  2211.   uchar cont;
  2212.   long search;
  2213.   struct Program *prog=scr->prog;
  2214.   struct fplVariable *tempvar;
  2215.   uchar reference;
  2216.   long breaks;
  2217.  
  2218.   GETMEM(val, sizeof(struct Expr));
  2219.   if(file!=func->data.inside.file) {
  2220.     struct Program *prog=scr->programs;
  2221.     while(prog) {
  2222.       if(prog->name && !strcmp(prog->name, func->data.inside.file))
  2223.         break;
  2224.       prog=prog->next;
  2225.     }
  2226.     if(prog) {
  2227.       CALL(LeaveProgram(scr, scr->prog));
  2228.       CALL(GetProgram(scr, prog));
  2229.       scr->prog=prog;
  2230.     } else
  2231.       return(FPLERR_INTERNAL_ERROR); /* This is a dead-end error! */
  2232.   }
  2233.  
  2234.   if(func->flags&FPL_INSIDE_NOTFOUND) {
  2235.     /*
  2236.      * We have no current information about where this function
  2237.      * is to be found. Search for it and store the location in
  2238.      * ->text and ->prg.
  2239.      */
  2240.  
  2241.     cont=TRUE;
  2242.     search=(func->data.inside.ret==FPL_STRARG)?CMD_STRING:
  2243.     (func->data.inside.ret==FPL_INTARG)?CMD_INT:CMD_VOID;
  2244.  
  2245.     /*
  2246.      * Start searching from the declaration position to enable local functions!
  2247.      */
  2248.  
  2249.     scr->text=(&scr->prog->program)[scr->prog->startprg-1]+
  2250.       func->data.inside.col;
  2251.     scr->prg=func->data.inside.prg;
  2252.     scr->virprg=func->data.inside.virprg;
  2253.     scr->virfile=func->data.inside.virfile;
  2254.     while(cont && !ret) {
  2255.       switch(*scr->text) {
  2256.       case CHAR_OPEN_BRACE:
  2257.         /* ...go to the corresponding brace */
  2258.         ret=GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE);
  2259.         break;
  2260.       case CHAR_OPEN_PAREN:
  2261.         /* ...go to the corresponding parenthesis */
  2262.         ret=GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE);
  2263.         break;
  2264.       case CHAR_QUOTATION_MARK:
  2265.         scr->text++;
  2266.         /* dirty use of function: */
  2267.         ret=GetEnd(scr, CHAR_QUOTATION_MARK, CHAR_QUOTATION_MARK, FALSE);
  2268.         break;
  2269.       case CHAR_ASCII_ZERO:
  2270.         if(Newline(scr))
  2271.           ret=FPLERR_INSIDE_NOT_FOUND;
  2272.         break;
  2273.       case CHAR_DIVIDE: /* to eat comments */
  2274.       case CHAR_SPACE:
  2275.       case CHAR_TAB:
  2276.       case CHAR_NEWLINE:
  2277.         if(Eat(scr))
  2278.           ret=FPLERR_INSIDE_NOT_FOUND;
  2279.         if(*scr->text==CHAR_HASH) {
  2280.           /* This should read a #line statement for new virtual line number */
  2281.           while(*scr->text++!=CHAR_NEWLINE);
  2282.           scr->virprg++;
  2283.         }
  2284.         break;
  2285.       case CHAR_CLOSE_BRACE: /* local function searches might hit this! */
  2286.         ret=FPLERR_INSIDE_NOT_FOUND;
  2287.         break;
  2288.       default:
  2289.         if(isident(*scr->text)) {
  2290.           Getword(scr);
  2291.           GetIdentifier(scr, scr->buf, &pident);
  2292.           if(pident && /* valid identifier */
  2293.              pident->data.external.ID==search) {  /* and it's the right one */
  2294.             if(!Getword(scr)) {
  2295.               GetIdentifier(scr, scr->buf, &pident);
  2296.               if(pident && pident->flags&FPL_INSIDE_FUNCTION) /* an inside */
  2297.                 cont=strcmp(pident->name, func->name); /* is it the right? */
  2298.             }
  2299.           } else
  2300.             while(isident(*scr->text))
  2301.               scr->text++;
  2302.         } else
  2303.           scr->text++;
  2304.         break;
  2305.       }
  2306.     }
  2307.     if(ret) {
  2308.       strcpy(scr->buf, func->name); /* enable better error report! */
  2309.       scr->prg=p;
  2310.       scr->text=t;
  2311.       scr->virprg=vp;
  2312.       return FPLERR_INSIDE_NOT_FOUND; /* dead end error */
  2313.     }
  2314.     func->data.inside.col=scr->text-(&scr->prog->program)[scr->prg-1];
  2315.     func->data.inside.prg=scr->prg;
  2316.     func->data.inside.virprg=scr->virprg;
  2317.     func->data.inside.virfile=scr->virfile;
  2318.     func->flags&=~FPL_INSIDE_NOTFOUND; /* we have found it! */
  2319.   } else {
  2320.     /*
  2321.      * We know where to find this function!
  2322.      */
  2323.  
  2324.     scr->prg=func->data.inside.prg;
  2325.     scr->text=(&scr->prog->program)[scr->prg-1]+func->data.inside.col;
  2326.     scr->virprg=func->data.inside.virprg;
  2327.     scr->virfile=func->data.inside.virfile;
  2328.   }
  2329.  
  2330.   /**********************************
  2331.    * PARSE THE PARAMETER LIST HERE! *
  2332.    **********************************/
  2333.  
  2334.   CALL(Eat(scr));
  2335.  
  2336.   if(*scr->text!=CHAR_OPEN_PAREN) {
  2337.     CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  2338.     /* we can survive without that! */
  2339.   } else
  2340.     scr->text++;
  2341.  
  2342.   if(func->data.inside.format) {
  2343.     /*
  2344.      * We won't hit this if no arguments is prototyped.
  2345.      */
  2346.  
  2347.     count=0; /* parameter counter */
  2348.     text=func->data.inside.format;
  2349.  
  2350.     if(!*text) {
  2351.       if(!Getword(scr) && strcmp(scr->buf, "void")) {
  2352.         /* it should be "void" or nothing! If it wasn't we fail! */
  2353.         CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));
  2354.       }
  2355.     } else {
  2356.       while(*text && !ret) {
  2357.         CALL(Getword(scr));
  2358.         CALL(GetIdentifier(scr, scr->buf, &ident));
  2359.     CALL(Eat(scr));
  2360.         if(scr->text[0]==CHAR_MULTIPLY) {
  2361.       reference=TRUE;
  2362.       scr->text++; /* pass it! */
  2363.     }
  2364.     else
  2365.           reference=FALSE; /* no reference! */
  2366.  
  2367.         switch(*text) {
  2368.         case FPL_STRARG:
  2369.         case FPL_INTARG:
  2370.       if(reference) {
  2371.         /*
  2372.          * It was said to a symbol reference!!
  2373.          */
  2374.             return FPLERR_ILLEGAL_REFERENCE;
  2375.       }
  2376.  
  2377.           if((*text==FPL_STRARG &&
  2378.              ident->data.external.ID!=CMD_STRING) ||
  2379.              (*text==FPL_INTARG &&
  2380.              ident->data.external.ID!=CMD_INT))
  2381.             return FPLERR_ILLEGAL_DECLARE;
  2382.  
  2383.           /*
  2384.            * Declare the following word as a string or integer
  2385.            * variable.
  2386.            */
  2387.           GETMEM(pident, sizeof(struct Identifier));
  2388.  
  2389.           CALL(Getword(scr));
  2390.  
  2391.           tempvar=&pident->data.variable;
  2392.  
  2393.           pident->flags=(*text==FPL_INTARG?FPL_INT_VARIABLE:
  2394.                          FPL_STRING_VARIABLE)|
  2395.                            (ident->flags&FPL_VARIABLE_LESS32);
  2396.  
  2397.           STRDUP(pident->name, scr->buf);
  2398.  
  2399.           tempvar->num=0; /* This is not an array */
  2400.           tempvar->size=1; /* This is not an array */
  2401.           GETMEM(tempvar->var.val32, sizeof(void *));
  2402.           if(*text==FPL_INTARG) {
  2403.             tempvar->var.val32[0]=(long)arg->argv[count];
  2404.           } else {
  2405.             /* Store string length in variable `len' */
  2406.             register long len=GETSTRLEN(arg->argv[count]);
  2407.             GETMEM(tempvar->var.str[0], sizeof(struct fplStr)+len);
  2408.             tempvar->var.str[0]->alloc=len;
  2409.  
  2410.             /* We copy the ending zero termination too! */
  2411.             memcpy(tempvar->var.str[0]->string, ((uchar *)arg->argv[count]), len+1);
  2412.             tempvar->var.str[0]->len=len;
  2413.           }
  2414.           /*
  2415.            * Emulate next level variable declaration by adding one
  2416.            * to the ->level member here... dirty but (fully?)
  2417.            * functional!!!! ;-)
  2418.            */
  2419.  
  2420.           pident->level=scr->varlevel+1;
  2421.           pident->file=scr->prog->name;
  2422.           pident->func=func;
  2423.           CALL(AddVar(scr, pident, &locals));
  2424.           break;
  2425.         case FPL_STRVARARG:
  2426.         case FPL_INTVARARG:
  2427.     case FPL_STRARRAYVARARG:
  2428.     case FPL_INTARRAYVARARG:
  2429.       if(!reference) {
  2430.         /*
  2431.          * It was never said to be a symbol reference!!
  2432.          */
  2433.             return FPLERR_ILLEGAL_REFERENCE;
  2434.       }
  2435.           if((*text==FPL_STRVARARG || *text == FPL_STRARRAYVARARG) &&
  2436.          ident->data.external.ID!=CMD_STRING) {
  2437.         return FPLERR_ILLEGAL_DECLARE;
  2438.  
  2439.           } else if((*text==FPL_INTVARARG || *text == FPL_INTARRAYVARARG) &&
  2440.             ident->data.external.ID!=CMD_INT) {
  2441.             return FPLERR_ILLEGAL_DECLARE;
  2442.           }
  2443.           /*
  2444.            * Declare the following word as a variable which
  2445.            * will use the struct fplVariable pointer as given in the
  2446.            * calling parameter list.
  2447.            */
  2448.  
  2449.           CALL(Getword(scr));
  2450.  
  2451.       if(*text == FPL_INTARRAYVARARG ||
  2452.          *text == FPL_STRARRAYVARARG) {
  2453.           CALL(Eat(scr));
  2454.               if(CHAR_OPEN_BRACKET != scr->text[0])
  2455.                 return FPLERR_ILLEGAL_DECLARE;
  2456.           if(GetEnd(scr, CHAR_CLOSE_BRACKET, CHAR_OPEN_BRACKET, FALSE))
  2457.                 return FPLERR_MISSING_BRACKET;
  2458.       }
  2459.  
  2460.           if(arg->argv[count]) {
  2461.             /*
  2462.              * If the wrong kind of variable was sent in the function call, no
  2463.              * varible will be sent, and no one will be declared.
  2464.              */
  2465.  
  2466.             GETMEM(pident, sizeof(struct Identifier));
  2467.  
  2468.             *pident=*(struct Identifier *)arg->argv[count];
  2469.             pident->flags |= FPL_REFERENCE;
  2470.             pident->data.variable.ref= (struct Identifier *)arg->argv[count];
  2471.             /* original fplVariable position */
  2472.  
  2473.             STRDUP(pident->name, scr->buf);
  2474.  
  2475.             pident->level=scr->varlevel+1;
  2476.             pident->file=scr->prog->name;
  2477.             pident->func=func;
  2478.             CALL(AddVar(scr, pident, &locals));
  2479.           }
  2480.           break;
  2481.         }
  2482.         CALL(Eat(scr));
  2483.  
  2484.         if(*++text && *scr->text++!=CHAR_COMMA)
  2485.           /*
  2486.            * There is no way out from this error exception. Leaving a parameter
  2487.            * really is a sever thing!
  2488.            */
  2489.           return(FPLERR_MISSING_ARGUMENT);
  2490.         count++;
  2491.       }
  2492.     }
  2493.  
  2494.     CALL(Eat(scr));
  2495.  
  2496.     if(*scr->text!=CHAR_CLOSE_PAREN) {
  2497.       CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  2498.       /* who needs ending parentheses? */
  2499.     } else
  2500.       scr->text++;
  2501.   } else {
  2502.     /*
  2503.      * No argument is useable to this function. There might be a
  2504.      * `void' keyword here, but nothing else! Just search for the
  2505.      * closing parenthesis to fasten interpreting!
  2506.      */
  2507.  
  2508.     if(ret=GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, FALSE)) {
  2509.       CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  2510.       /* ok, then search for the open brace where the program starts! */
  2511.       ret=GetEnd(scr, CHAR_OPEN_BRACE, CHAR_OPEN_PAREN, FALSE);
  2512.       if(ret) {
  2513.         CALL(Warn(scr, FPLERR_MISSING_BRACE));
  2514.       } else
  2515.         scr->text--; /* back on brace */
  2516.       /* ok, then we say that the program starts right here! */
  2517.     }
  2518.   }
  2519.  
  2520.   /*********************
  2521.    * RUN THE FUNCTION! *
  2522.    *********************/
  2523.  
  2524.   oldret=scr->strret;
  2525.   scr->strret=func->data.inside.ret==FPL_STRARG; /* should we receive a string? */
  2526.   CALL(Eat(scr));
  2527.   if(*scr->text!=CHAR_OPEN_BRACE) {
  2528.     CALL(Warn(scr, FPLERR_MISSING_BRACE));
  2529.     /* we can do with a start without it! */
  2530.   } else
  2531.     scr->text++;
  2532.  
  2533.   con.bracetext=scr->text;
  2534.   con.braceprg=scr->prg;
  2535.   text=(void *)scr->func; /* backup current */
  2536.   scr->func=func;
  2537.  
  2538.   breaks = scr->breaks;
  2539.   scr->breaks=0;
  2540.  
  2541.   scr->prog->openings++;
  2542.   ret=Script(scr, val, SCR_BRACE|SCR_FUNCTION, &con);
  2543.   scr->prog->openings--;
  2544.  
  2545.   scr->breaks=breaks;
  2546.  
  2547.   /*
  2548.    * Delete all variables created on our list for use
  2549.    * only in the function we just came back from!
  2550.    */
  2551.   DelLocalVar(scr, &locals);
  2552.  
  2553.   if(!ret && val->flags & FPL_CONTINUE)
  2554.     ret = FPLERR_ILLEGAL_CONTINUE;
  2555.  
  2556.   if(ret) {
  2557.     if(scr->prog != prog) {
  2558.       LeaveProgram(scr, scr->prog); /* leave the failed program! */
  2559.       GetProgram(scr, prog); /* fetch the previous program again! */
  2560.     }
  2561.     return(ret);
  2562.   }
  2563.   scr->func=(void *)text; /* restore last */
  2564.  
  2565.   if(scr->strret) {
  2566.     /* we should return a string */
  2567.     if(string=val->val.str) {
  2568.       strtags[1]=(long)string->string;
  2569.       strtags[3]=string->len;
  2570.       CALL(Send(scr, strtags));
  2571.       /* FREE(string); until we used _DONTCOPY_ */
  2572.     }
  2573.     /*
  2574.       else {
  2575.       Got null pointer == zero string!
  2576.     }
  2577.     */
  2578.   } else {
  2579.     inttags[1]=val->val.val;
  2580.     CALL(Send(scr, inttags));
  2581.   }
  2582.  
  2583.   FREE(val);
  2584.  
  2585.   scr->text=t;
  2586.   scr->prg=p;
  2587.   scr->virprg=vp;
  2588.   scr->virfile=vf;
  2589.   scr->strret=oldret;
  2590.   if(scr->prog!=prog) {
  2591.     CALL(LeaveProgram(scr, scr->prog));
  2592.     scr->prog=prog;
  2593.     CALL(GetProgram(scr, scr->prog));
  2594.   }
  2595.   return(FPL_OK);
  2596. }
  2597.  
  2598. static ReturnCode INLINE PrototypeInside(struct Data *scr,
  2599.                      struct Expr *val,
  2600.                      long control,
  2601.                      struct Identifier *ident)
  2602. {
  2603.   /*
  2604.    * Prototyping an `inside' function!
  2605.    *
  2606.    * We have already received the return type, now we must
  2607.    * parse the paraters given within the parentheses. Legal
  2608.    * parameters are only combinations of `string', `int',
  2609.    * `string &' and `int &', or a single `void' (if no argument
  2610.    * should be sent to the function). Arguments specified in
  2611.    * a prototype is required, there is no way to specify an
  2612.    * optional parameter or a parameter list.
  2613.    */
  2614.  
  2615.   struct Identifier *pident;
  2616.   long pos=0;
  2617.   ReturnCode ret = FPL_OK;
  2618.   uchar *array;
  2619.   uchar found=ident?TRUE:FALSE;
  2620.  
  2621.   if(!found) {
  2622.     GETMEM(pident, sizeof(struct Identifier));
  2623.     STRDUP(pident->name, scr->buf);
  2624.   } else {
  2625.     /* we already know about this function! */
  2626.     if(ident->flags&(FPL_INTERNAL_FUNCTION|FPL_KEYWORD|FPL_EXTERNAL_FUNCTION))
  2627.       return FPLERR_IDENTIFIER_USED;
  2628.     pident = ident;
  2629.   }
  2630.  
  2631.   if(!found || (found && ident->flags&FPL_INSIDE_NOTFOUND)) {
  2632.     /* we know where this is... */
  2633.     pident->data.inside.col=scr->text-(&scr->prog->program)[scr->prg-1];
  2634.     pident->data.inside.prg=scr->prg;
  2635.     pident->data.inside.file=scr->prog->name;
  2636.     pident->data.inside.virprg=scr->virprg;
  2637.     pident->data.inside.virfile=scr->virfile;
  2638.  
  2639.     pident->file=scr->prog->name; /* file! */
  2640.     pident->func=scr->func; /* declared in this function */
  2641.     pident->level=control&CON_DECLGLOB?0:scr->varlevel;
  2642.   }
  2643.  
  2644.   if(found) {
  2645.     /* we already know about this function! */
  2646.  
  2647.     CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  2648.  
  2649.     CALL(Eat(scr));
  2650.  
  2651.     if(scr->text[0]==CHAR_OPEN_BRACE) {
  2652.       /* now the function is found! */
  2653.       if(!(ident->flags&FPL_INSIDE_NOTFOUND))
  2654.         /* the function has already been defined and is defined here again! */
  2655.         return FPLERR_IDENTIFIER_USED;
  2656.  
  2657.       ident->flags&=~FPL_INSIDE_NOTFOUND;
  2658.  
  2659.       if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE))
  2660.         return FPLERR_MISSING_BRACE;
  2661.       scr->text--; /* back on close brace */
  2662.       val->flags|=FPL_DEFUNCTION;
  2663.     }
  2664.  
  2665.     return FPL_OK;
  2666.   }
  2667.  
  2668.   pident->flags=FPL_INSIDE_FUNCTION|
  2669.     (control&CON_DECLEXP?FPL_EXPORT_SYMBOL:0)|
  2670.       (control&CON_DECLGLOB?FPL_GLOBAL_SYMBOL:0);
  2671.  
  2672.   scr->text++; /* pass the open parenthesis */
  2673.  
  2674.   CALL(Eat(scr));
  2675.  
  2676.   GETMEM(array, MAX_ARGUMENTS * sizeof(uchar));
  2677.  
  2678.   while(pos<MAX_ARGUMENTS) {
  2679.     if(*scr->text==CHAR_CLOSE_PAREN) {
  2680.       scr->text++;
  2681.       break;
  2682.     }
  2683.     CALL(Getword(scr));
  2684.     CALL(GetIdentifier(scr, scr->buf, &ident));
  2685.     CALL(Eat(scr));
  2686.     switch(ident->data.external.ID) {
  2687.     case CMD_VOID:
  2688.       if(*scr->text!=CHAR_CLOSE_PAREN) {
  2689.         CALL(Warn(scr, FPLERR_ILLEGAL_PROTOTYPE));
  2690.         CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  2691.       } else
  2692.         scr->text++;
  2693.       break;
  2694.  
  2695.     case CMD_STRING:
  2696.     case CMD_INT:
  2697.       if(*scr->text==CHAR_MULTIPLY) {
  2698.         scr->text++;
  2699.         Getword(scr); /* eat word if there's any! */
  2700.         if(CHAR_OPEN_BRACKET == scr->text[0]) {
  2701.           if(GetEnd(scr, CHAR_CLOSE_BRACKET, CHAR_OPEN_BRACKET, FALSE))
  2702.             return FPLERR_MISSING_BRACKET;
  2703.           array[pos]=(ident->data.external.ID==CMD_STRING)?FPL_STRARRAYVARARG:
  2704.           FPL_INTARRAYVARARG;
  2705.         }
  2706.         else
  2707.           array[pos]=(ident->data.external.ID==CMD_STRING)?FPL_STRVARARG:
  2708.           FPL_INTVARARG;
  2709.       } else
  2710.         array[pos]=(ident->data.external.ID==CMD_STRING)?FPL_STRARG:
  2711.         FPL_INTARG;
  2712.       break;
  2713.  
  2714.     default:
  2715.       CALL(Warn(scr, FPLERR_ILLEGAL_PROTOTYPE));
  2716.       continue; /* if we against all odds are ordered to go on! */
  2717.     }
  2718.     if(CMD_VOID == ident->data.external.ID)
  2719.       break;
  2720.  
  2721.     pos++;
  2722.     if(isident(*scr->text)) {
  2723.       Getword(scr);
  2724.       CALL(Eat(scr));
  2725.     }
  2726.  
  2727.     if(*scr->text==CHAR_COMMA)
  2728.       scr->text++;
  2729.     else if(*scr->text!=CHAR_CLOSE_PAREN) {
  2730.       CALL(Warn(scr, FPLERR_ILLEGAL_PROTOTYPE));
  2731.       /* we can go on if we just forgot the closing parenthesis */
  2732.     }
  2733.   }
  2734.  
  2735.   array[pos]=0; /* terminate string */
  2736.  
  2737.   /*
  2738.    * We have all information now. AddIdentifier().
  2739.    */
  2740.  
  2741.   pident->data.inside.ret=(control&CON_DECLSTR)?FPL_STRARG:
  2742.     (control&CON_DECLINT)?FPL_INTARG:FPL_VOIDARG;
  2743.   GETMEM(pident->data.inside.format, pos+1);
  2744.   strcpy(pident->data.inside.format, array);
  2745.   FREE(array);
  2746.  
  2747.   CALL(Eat(scr)); /* Eat white space */
  2748.  
  2749.  
  2750.   if(*scr->text==CHAR_OPEN_BRACE) {
  2751.     /* It's the actual function!!! */
  2752.     if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE))
  2753.       return FPLERR_MISSING_BRACE;
  2754.     scr->text--; /* back on close brace */
  2755.     val->flags|=FPL_DEFUNCTION;
  2756.   } else {
  2757.     val->flags&=~FPL_DEFUNCTION;
  2758.     pident->flags|=FPL_INSIDE_NOTFOUND;
  2759.   }
  2760.   CALL(AddVar(scr, pident,
  2761.               control&CON_DECLGLOB?&scr->globals:&scr->locals));
  2762.  
  2763.   return(ret);
  2764. }
  2765.